In the QUANTIFYING VISUALIZATION VIBES project studies, participants completed an attribution eliciation survey, asking questions about their social inferences drawn from (5) stimulus images (data visualizations). Each participant was randomly assigned to one of 6 stimulus blocks, each containing 1 image from each of (4) ‘embellishment categories’ (ranging from most abstract to most figural). Each participant started by responding to questions for a single ‘common’ stimulus (B0-0). Two participant recruitment pools were used: Tumblr (to replicate and compare survey results to the interview study conducted by Morgenstern, Fox, Jones & Satyanarayan (under review)) and a broader demographic sample recruited via Prolific.

This notebook contains code to replicate quantitative analysis of data reported in VIS submission #1006.

SETUP

Import Packages

knitr::opts_chunk$set(echo = TRUE)

#UTILITIES
library(Hmisc) # %nin% operator
library(psych) #describe()
library(tidyverse) #all the things
library(magrittr) #special pipes like %<>%
library(summarytools) #data quality
library(lubridate) #dealing with dates
library(tinytable) ##sparkline tables 
library(webshot2) ##saving sparkline tables

#EDA
library(qacBase)

#VIZ
library(ggformula) #regression syntax viz
library(ggstatsplot) #dummies
library(gghalves) #half boxplots 
library(GGally) #extends ggplot for EDA 
library(corrplot) #sophisticated correlation plots
library(ggeasy) #easy labelling
library(ggh4x) #guides [dual axes]
library(patchwork) #multi-plot layout
library(ggdist) #raincloud plots and other distributionals
library(viridis) #color palettes
library(RColorBrewer) #color palettes
library(plotly) # interactive graphs
library(paletteer) #more palettes
library(interactions) ##easier regression ixn plots.srlsy
library(tidygraph)
library(ggsankey) ## sankey plots for study 3 categorical change



#MODELLING
library(jtools) #Social Science regression utilities
library(easystats) #modelling helpers
library(see)
library(sjPlot)
library(lme4)
library(lmerTest) #for CIs in glmer
# library(mixed) ## utilities for glmers 
library(jmv) ## jamovi EFA


#STATISTICAL TESTS 
library(kSamples) #AD K-SAMPLE TEST (for distribution comparison)
library(rstatix) #FRIEDMAN'S TESTS and effect sizes 

#CONFIG
options(readr.show_col_types = FALSE) #don't show coltypes on read_csv
n_blocks = 6

## IMPORTANT 
GRAPH_SAVE = FALSE #set to true to generate all the SD graphs and save to folders (note this will overwrite existing graphs)
source("graphing_functions.R") #import graphing palettes and custom functions

Import References

############## IMPORT REFERENCE FILES
ref_stimuli <- readRDS("data/reference/ref_stimuli.rds")
ref_labels <- readRDS("data/reference/ref_labels.rds")


############## SETUP Graph Labels
ref_labels_min <- readRDS("data/REFERENCE/ref_labels_S3.rds")
ref_stim_id <- levels(ref_stimuli$ID)
ref_cat_questions <- c("MAKER_ID","MAKER_AGE","MAKER_GENDER")
ref_free_response <- c("MAKER_DETAIL", "MAKER_EXPLAIN", "TOOL_DETAIL", "CHART_EXPLAIN")
ref_conf_questions <- c("MAKER_CONF", "AGE_CONF", "GENDER_CONF", "TOOL_CONF")
ref_sd_questions <- rownames(ref_labels)

# ref_blocks <- c("block1", "block2", "block3", "block4", "block5", "block6")
ref_blocks <- c(1,2,3,4,5,6)



############## MINIMAL QUESTION SET FOR Study 3
ref_min_sd_questions <-  c("DESIGN","DATA","POLITICS", "TRUST","ALIGN","BEAUTY","INTENT")
ref_min_sd_questions_z <-  c("DESIGN_z","DATA_z","POLITICS_z", "TRUST_z","ALIGN_z","BEAUTY_z","INTENT_z")
ref_min_conf_questions <- c("ID_CONF","AGE_CONF","GENDER_CONF")
ref_min_cat_questions <- c("ID","AGE","GENDER","ENCOUNTER")
# ref_min_free_questions <- c("EXPLAIN")

Import Data

############## IMPORT COMBINED DATA FILES
df_participants_all <- readRDS("data/input/df_participants_ALL.rds") #1 row per participant — demographic
df_graphs_all <- readRDS("data/input/df_graphs_ALL.rds") #1 row per participantXgraph (i.e. a trial)
df_sd_questions_long_all <- readRDS("data/input/df_sd_questions_long_ALL.rds") #1 row per participantXgraphXSD question  (i.e. a question on one trial)


############## STUDY 1 & 2 DATA FILES
df_graphs <- readRDS("data/input/df_graphs.rds") #only categorical and numeric questions
df_sd_questions_long_z <- readRDS("data/input/df_sd_questions_long_z.rds") # only sd questions LONG, zscored

############## IMPORT Study 3 DATA FILES
df_graphs_s3 <- readRDS("data/input/df_graphs_s3.rds") #only categorical and numeric questions from Study 3
df_questions_s3 <- readRDS("data/input/df_questions_S3.rds")

METHODS

(3.2) Participants

df <- df_participants_all

## FOR DESCRIPTIVES PARAGRAPH
# STUDY 1
df1 <- df %>% filter(Study == "Study1")
desc.gender.1 <- table(df1$D_gender) %>% prop.table()
names(desc.gender.1) <- levels(df1$D_gender)
participants_s1 <- nrow(df1)

# STUDY 2
df2 <- df %>% filter(Study == "Study2")
desc.gender.2 <- table(df2$D_gender) %>% prop.table()
names(desc.gender.2) <- levels(df2$D_gender)
participants_s2 <- nrow(df2)


# STUDY 3
df3 <- df %>% filter(Study == "Study3")
desc.gender.3 <- table(df3$D_gender) %>% prop.table()
names(desc.gender.3) <- levels(df3$D_gender)
participants_s3 <- nrow(df3)

As Reported in Section 3.2 Participants :

78 US-Based English-speaking individuals users of the social media platform TUMBLR participated in Study 1, ( 36% Female, 5% Male, 40% Non-binary, 3 % Prefer Not to Say, 17% Prefer to Self Describe).

240 US-Based English-speaking individuals were recruited from Prolific to participate in Study 2, ( 54% Female, 42% Male, 3% Non-binary, 0.4% Prefer to Self Describe, 0% Prefer Not to Say. Other).

40 US-Based English-speaking individuals were recruited from Prolific to participate in Study 3, ( 50% Female, 47.5% Male, 2.5% Non-binary, 0% Prefer to Self Describe, 0% Prefer Not to Say. Other).

rm(df, df1, desc.gender.1, participants_s1, df2, desc.gender.2, participants_s2, df3, desc.gender.3, participants_s3)

(3.3) Survey Response Time

df <- df_participants_all

## for descriptives paragraph
s12.desc.duration <- psych::describe(df %>% filter(Study %in% c("Study1","Study2")) %>% pull(duration.min))
s3.desc.duration <- psych::describe(df %>% filter(Study == "Study3") %>% pull(duration.min))

As Reported in Section 3.3 Procedure :

In studies 1 and 2, responses ranged from 11 to 228 minutes, with a mean response time of 45 minutes, SD = 26.

In study 3, responses ranged from 13 to 110 minutes, with a mean response time of 41 minutes, SD = 20.

rm(df, s12.desc.duration, s3.desc.duration)

RESULTS

(4.1.2) Variance in Confidence

library(tinytable)
library(webshot2)


## SETUP LIST OF NUMERIC DATAFRAMES 
all_q <- c(ref_min_conf_questions)


## DECIDE DATAFRAME VERSION (Raw, minimal questions)
df <- df_graphs_all %>% 
  filter(
    #filter for only block 1 data
    Assigned.Block==1, 
    #drop pilot data 
    Study != "Study0"
  ) %>% 
  #drop z-score cols
  select(-contains("_z"), -contains("_politics")) %>% 
  #only include studies 1 and 2
  filter(Study !="Study3") %>% 
  droplevels()


## SANITY CHECK INCLUDED DATA
# addmargins(table(df$Study, df$Assigned.Block)/5)

## SETUP NUMERIC DATAFRAME
df_num <- df %>% select(all_of(all_q))

############ POPULATE LIST OF FILTERED DATAFRAMES NUMERIC QUESTIONS
d_q <- c(ref_min_conf_questions)
stimuli <- as.vector(levels(df$STIMULUS))

# Define row and column names
col_names <- d_q 
row_names <- stimuli

# Initialize an empty list to store the structure
m <- list() ## MINIMAL LIST OF JUST NUMERIC VALUS
f <- list() ## DATAFRAME WITH STUDY AND SAMPLE

# Loop over row names
for (s in row_names) { #ROWS ARE QUESTIONS
  # Initialize an empty list for each row
  m[[s]] <- list()
  f[[s]] <- list()
  
  # Loop over column names
  for (q in col_names) { #COLS ARE STIMULI
    # Create a small dataframe for demonstration
    # m[[r]][[c]] <- data.frame(Value = sample(1:10, 5, replace = TRUE))
    m[[s]][[q]] <- df %>% filter(STIMULUS==s) %>% select(q) %>% pull()
    f[[s]][[q]] <- df %>% filter(STIMULUS==s) %>% select(Study,q) 
  }
}
################################################


####### WORKS WITH NUMBER ONLY DATAFRAME passed through data = 
# CUSTOM DENSITY PLOT
dist <- function(d, ...){
  d <- as.data.frame(d)
  ggplot(d,aes(x = d )) +
      geom_density(alpha=0.5, fill="black") +
      theme_void()
}
###########################################################


##density faceted by color
custom_plot <- function(x, question_name, full_data,...) {
  # 'x' is a vector (extracted column) — useless
  # 'full_data' is the original list of dataframes
  ## CONSTRUCT DATAFRAME
  vf <- full_data[[question_name]]
  # browser()
    ggplot(vf, aes(x = vf[[2]], fill = Study)) +
    geom_density(alpha=0.5) +
    scale_fill_manual(values = my_palettes(name="simple_studies", direction = "1")) +
    scale_color_manual(values = my_palettes(name="simple_studies", direction = "1")) +
    theme_void() + easy_remove_legend()
}
###########################################################

###########################################################
make_row_tracking_fun <- function(rows, full_data, tab) {
  counter <- 0
  function(x, ...) {
    counter <<- counter + 1
    current_index <- rows[counter]
    question_name <- tab$VARIABLE[current_index]
    
    custom_plot(
      x = x,
      # row_index = current_index,
      full_data = full_data,
      question_name = question_name,
      ...
    )
  }
}



#### SETUP TABLE
tab <- data.frame(
  VARIABLE = all_q,
  LABEL = c("Maker Confidence", "Age Confidence","Gender Confidence"),
  AGGREGATE = "",
  B1_A="",
  B1_B="",
  B1_C="",
  B1_D="",
  B0_D=""
  # STATISTICS = c(stat_id, stat_age, stat_gender, stat_encounter,stat)
  # STATISTICS = c(stat_id, stat_age, stat_gender, stat_tools, stat_encounter, stat_action2, stat_action4, stat)
    # c("","","","","","","",stat)
)


##hacky workaround for plot_tt not passing row number to function
row_counter <- 0
rows <- 1:3


############## TINY TABLE
### themes: bootstrap, grid, spacing
t <- tinytable::tt(tab, theme = "bootstrap") %>%
  ## PLOT AGGREGATE PLOTS IN COLUMN 2
  plot_tt(j=3, i= rows, fun=dist, data = df_num, color="black") %>% 
  ## PLOT B1_A IN COLUMN 3
  plot_tt(j=4, i=rows, fun = make_row_tracking_fun(rows, f[["B1-1"]],tab), data = f[["B1-1"]]) %>% 
  plot_tt(height=1,j=5, i=rows, fun = make_row_tracking_fun(rows, f[["B1-2"]],tab), data = f[["B1-2"]]) %>%
  plot_tt(height=1,j=6, i=rows, fun = make_row_tracking_fun(rows, f[["B1-3"]],tab), data = f[["B1-3"]]) %>%
  plot_tt(height=1,j=7, i=rows, fun = make_row_tracking_fun(rows, f[["B1-4"]],tab), data = f[["B1-4"]]) %>%
  plot_tt(height=1,j=8, i=rows, fun = make_row_tracking_fun(rows, f[["B0-0"]],tab), data = f[["B0-0"]])
  

## saved manually as png 
# if(GRAPH_SAVE){
#   # save_tt(t, output="figs/tables/sparklines.png", overwrite = TRUE) ## CAN'T SAVE, HAVE TO MANUALLY SAVE FROM VIEWER WINDOW
#   save_tt(t, output="figs/tables/confidence_sparklines.tex", overwrite = TRUE)
# }

## TO RENDER TO VIEWER
print("note that object t can only be rendered to viewer in RStudio, not to Rmd notebook")
## [1] "note that object t can only be rendered to viewer in RStudio, not to Rmd notebook"
t
VARIABLE LABEL AGGREGATE B1_A B1_B B1_C B1_D B0_D
ID_CONF Maker Confidence
AGE_CONF Age Confidence
GENDER_CONF Gender Confidence
##CLEANUP
rm(tab,m,f,col_names, row_names, all_q, df, d_q, df_num, stimuli)

(4.1.3) Variance in Identifications & Characterizations

Statistical Model

As reported in 4.3.1, here we test for significant effects in a model predicting response by QUESTION and STIMULUS (for Studies 1&2, Block 1) to verify that survey responses do indeed vary in response to each question and stimulus.

## SETUP DATA 
df <- df_sd_questions_long_z %>%
  filter(Study %in% c("Study1","Study2")) 
  # mutate(
  #   STIMULUS = factor(STIMULUS, levels=c("B0-0","B1-2","B1-1","B1-3","B1-4")),
  #   QUESTION = factor(QUESTION, levels = c("DESIGN","DATA","POLITICS","TRUST","ALIGN","INTENT","BEAUTY"))
  # ) %>%
  # droplevels()
  
## SANITY CHECK data in model
# table(df$Study, df$STIMULUS)

## MODEL question response by question and stimulus
  m1 <- lmer(value ~ QUESTION * STIMULUS + (1|PID), data = df)
  # summary(m1)
  # anova(m1)
  
## MODEL question response by question and stimulus and study
  m2 <- lmer(value ~ QUESTION * STIMULUS + Study + (1|PID), data = df)
  # summary(m2)
  anova(m2)
## Type III Analysis of Variance Table with Satterthwaite's method
##                    Sum Sq Mean Sq NumDF   DenDF F value    Pr(>F)    
## QUESTION            89.78  8.9782    10 16900.8 10.8574 < 2.2e-16 ***
## STIMULUS            64.16  2.6731    24  3121.6  3.2326  1.88e-07 ***
## Study                1.72  1.7218     1   312.7  2.0822      0.15    
## QUESTION:STIMULUS 2872.99 11.9708   240 16900.8 14.4763 < 2.2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
  compare_performance(m1,m2,rank = TRUE)
## # Comparison of Model Performance Indices
## 
## Name |           Model | R2 (cond.) | R2 (marg.) |   ICC |  RMSE | Sigma
## ------------------------------------------------------------------------
## m2   | lmerModLmerTest |      0.185 |      0.166 | 0.023 | 0.898 | 0.909
## m1   | lmerModLmerTest |      0.185 |      0.166 | 0.023 | 0.898 | 0.909
## 
## Name | AIC weights | AICc weights | BIC weights | Performance-Score
## -------------------------------------------------------------------
## m2   |       0.514 |        0.506 |       0.021 |            62.50%
## m1   |       0.486 |        0.494 |       0.979 |            37.50%
## USE EMMEANS TO GET MORE INTERPRETABLE COEFFICIENTS 
# library(emmeans)
# contrast(emmeans(m2, ~ QUESTION * STIMULUS), method = "eff")
# contrast(emmeans(m2, ~ QUESTION), method = "eff")
# contrast(emmeans(m2, ~ STIMULUS), method = "eff")

Note that analysis of variance for the model predicting (value) by an interaction between QUESTION and STIMULUS with linear fixed term Study indicates a significant interaction between QUESTION as STIMULUS (as expected), and a non-significant fixed effect of Study (indicating answers did not significantly vary between Study 1 and Study 2).

  • Significant main effect of question (\(F(10) = 11, p <0.001\))

  • Significant main effect of stimulus (\(F(24) = 3, p <0.001\))

  • Significant interaction of stimulus and question (\(F(240) =14.48, p < 0.001\)) (reported in paper)

  • Not significant main effect of study (\(F(1) = 2, p = 0.15\)) (reported in paper)

The following code blocks generate stimulus-level images for responses to short-form survey questions from Block 1.. Note that these images are manually combined in an vector-illustration program for annotation.

Semantic Differential Questions (Block 1)

This plots the short_form survey set of semantic differential questions for BLOCK 1 stimuli for Study 1,2,3 faceting by pre/post on study 3, visualized as a stacked ridgeplot (Note: these plots are written to the figs directory, not displayed inline)

#### DENSITY RIDGES#############################################################################
#### loop over questions and stimuli, vertically stack studies, color by sample

## DEFINE DF
df <- df_sd_questions_long_all%>% 
  #only block 1 for balanced data
  filter(Assigned.Block==1) %>% 
  #drop pilot data
  filter(Study != "Study0") %>% 
  #for Study 3 ONLY, set SAMPLE = TIME (for graphing purpose)
  mutate(
    Sample = case_when(Study =="Study3" ~ TIME ,
                       .default = Sample)) %>% 
  mutate(Sample = factor(Sample, levels = c("TUMBLR","GENERAL","POST","PRE"))) %>% 
  mutate(Study = factor(Study, levels=order_study)) %>% 
  droplevels()
  
  

## DEFINE REFS
n_q <- length(levels(df$QUESTION))
stimuli <- levels(df$STIMULUS)
questions <- ref_min_sd_questions #has qs in right order
labels <- ref_labels_min

## SET INITIAL VALUES
s <- stimuli[1]
q <- questions[1]
x = list() #list of plots

## LOOP OVER STIMULI, LOOP OVER QUESTIONS

for (s in stimuli){
  i=0
  # print(s)
  for (q in questions) {
    i = i+1
    # print(i)
    # print(q)
  
    ## FILTER Q AND CALCULATE MEDIAN
    d <- df %>% filter(STIMULUS ==s) %>% filter(QUESTION ==q) %>% 
    group_by(Study,Sample) %>% 
    mutate(m=median(value)) ## calc median for printing on graph
  
    x[[i]] <- 
      ggplot(d, aes(x = value, y = Study, fill = Sample, color = Sample, )) +
      geom_density_ridges2(scale = 0.75, panel_scaling = TRUE, rel_min_height = 0.01, alpha = 0.25,
          # ## POINT JITTER GEOMETRY
          # jittered_points = TRUE, alpha = 0.7, scale = 0.9)+
           # ## RUG GEOMETRY
            jittered_points = TRUE,
            position = position_points_jitter(width = 0.5, height = 0),
            point_shape = '|', point_size = 3, point_alpha = 0.5) +
      scale_x_continuous(limits=c(0,100)) +
      scale_fill_manual(values = my_palettes(name="simple_samples", direction = "1")) +
      scale_color_manual(values = my_palettes(name="simple_samples", direction = "1")) +
      ## MEDIAN
      stat_summary(fun=median, geom="text", fontface = "bold", size= 5,
                vjust=1.5, hjust = 0.50, aes(label=round(m, digits=0)))+
      stat_summary(fun=median, geom="point", size=2) +
   
      labs (title = q, y = "", x = "") +
      guides(
        y = guide_axis_manual(labels = labels[q,"left"]),
        y.sec = guide_axis_manual(labels = labels[q,"right"]),
        # x.sec = guide_axis_manual(position = "top", title = q, breaks = NULL)
        ) +
      theme_ridges(grid = TRUE, center_axis_labels = TRUE) + easy_remove_legend() 
  
  }## END loop over questions

  ## JOIN QUESTION LEVEL PLOTS FOR THIS STIMULUS
  title <- ref_stimuli %>% filter(ID == s) %>% select(NAME)  ##TODO IF NOT WORK ref_stim_id
  title <- paste(s,"|",title)
  p <- x[[1]] / x[[2]] /x[[3]] / x[[4]] /x[[5]] / x[[6]] /x[[7]] 
  p <- p + plot_annotation(
     title = title,
     subtitle ="", caption = "(point is median)")

  ## SAVE GRAPH FOR THIS STIMULIS 
  if(GRAPH_SAVE == TRUE) {
     ggsave(plot = p, path="figs/FIG5_Descriptives", filename =paste0("SD_ridges_",s,".png"), units = c("in"), width = 8, height = 24,  bg='#ffffff'  )}

1}## END LOOP OVER STIMULI

Categorical Variables (Studies 1&2) (Block1)

## SETUP DATA 
 df <- df_graphs %>% 
  select(PID, Assigned.Block, Study, STIMULUS, ENCOUNTER, MAKER_ID, MAKER_AGE,MAKER_GENDER) %>% 
  filter(Study %in% c("Study1", "Study2")) %>%
  filter(Assigned.Block ==1) %>% 
  mutate(Study = factor(Study, levels=order_study)) %>% 
  #reorder stimuli
  mutate(STIMULUS = factor(STIMULUS, levels=c("B1-1","B1-2","B1-3","B1-4","B0-0")))


######## FACETED BARPLOT MAKER
(ID <-  df %>% 
  ggplot(aes(x=Study, fill=MAKER_ID)) + 
    geom_bar(position="fill") + 
    scale_fill_manual(values = my_palettes(name="reds", direction = "1"))+
   facet_grid( .~ STIMULUS) + 
   coord_flip() +
   labs(title="MAKER_BY_STIMULUS_B1")

)

######## FACETED BARPLOT AGE
(AGE <- df %>% 
  ggplot(aes(x=Study, fill=MAKER_AGE)) + 
    geom_bar(position="fill") + 
    scale_fill_manual(values = my_palettes(name="lightblues", direction = "1"))+
   facet_grid( .~ STIMULUS) + 
   coord_flip() + 
    labs(title="AGE_BY_STIMULUS_B1")
) 

######## FACETED BARPLOT GENDER
(GENDER <-  df %>% 
  ggplot(aes(x=Study, fill=MAKER_GENDER)) + 
    geom_bar(position="fill") + 
    scale_fill_manual(values = my_palettes(name="smallgreens", direction = "1"))+
   facet_grid( .~ STIMULUS) + 
   coord_flip()+
   labs(title="GENDER_BY_STIMULUS_B1")
)   

######## FACETED BARPLOT ENCOUNTER
(ENCOUNTER <-  df %>% 
  ggplot(aes(x=Study, fill=ENCOUNTER)) + 
    geom_bar(position="fill") + 
    scale_fill_manual(values = my_palettes(name="encounter", direction = "1"))+
   facet_grid( .~ STIMULUS) + 
   coord_flip() + 
   labs(title="ENCOUNTER_ID_BY_STIMULUS_B1")
)

if(GRAPH_SAVE){
  
ggsave(plot = ID, path="figs/FIG5_Descriptives", filename =paste0("MAKER_by_stimulus.png"), units = c("in"), width = 12, height = 2 ,  bg='#ffffff'  )
  
ggsave(plot = AGE, path="figs/FIG5_Descriptives", filename =paste0("AGE_by_stimulus.png"), units = c("in"), width = 12, height = 2 ,  bg='#ffffff'  )
  
ggsave(plot = GENDER, path="figs/FIG5_Descriptives", filename =paste0("GENDER_by_stimulus.png"), units = c("in"), width = 12, height = 2 ,  bg='#ffffff'  )
  
ggsave(plot = ENCOUNTER, path="figs/FIG5_Descriptives", filename =paste0("ENCOUNTER_by_stimulus.png"), units = c("in"), width = 12, height = 2 ,  bg='#ffffff'  )
}

Categorical Variables Sankey (Study 3) (Block 1)

MAKER

### FILTER FOR ONLY ID QUESTION
df <- df_graphs_s3 %>% 
  mutate(STIMULUS = factor(STIMULUS, levels=c("B1-1","B1-2","B1-3","B1-4","B0-0"))) %>% 
  select(PRE_ID, POST_ID, STIMULUS, PID) %>% 
  mutate(
    PRE_ID = factor(PRE_ID, levels = rev(order_maker)),
    POST_ID = factor(POST_ID, levels = rev(order_maker))
  )

### {GGSANKEY} ################################

## REPEATED MEASURES
## SANKEY DIAGRAM
## MUST RESHAPE FOR SANKEY 
ds <- df %>% 
  ##custom from ggsankey
  make_long(PRE_ID, POST_ID, value=STIMULUS) %>% 
  mutate(
    node = factor(node, levels=rev(order_maker)),
    next_node= factor(next_node, levels=rev(order_maker)),
    match = ifelse(node==next_node, 1, 0.5), # try to highlight throughflows
  ) 

(S <- ggplot(ds, aes(x = x, 
               next_x = next_x, 
               node = node, 
               next_node = next_node,
               fill = node
               ))+
  geom_sankey(width = 0.25, flow.alpha = 0.65, node.alpha = 1, node.color = "white") +
  # geom_sankey_text(aes( x = as.numeric(x),  label = after_stat(freq)),
  #         size = 3, color = "white", fontface = "bold", check_overlap = TRUE) +
  scale_fill_manual(values = my_palettes(name="reds", direction = "-1"), guide = guide_legend(reverse = TRUE)) +
  labs(title = "CHANGE in MAKER ID by STIMULUS", 
       x = "TIME", y = "(count)", fill = "MAKER",
       caption = "") + 
  theme_minimal() + facet_grid(.~value)
)

#############################################

if(GRAPH_SAVE == TRUE) {
    ggsave(plot = S, path="figs/FIG5_Descriptives", filename =paste0("S3_ID_CHANGE_by_STIMLUS.png"), units = c("in"), width = 16, height = 8,  bg='#ffffff'  )
  }

AGE

### FILTER FOR ONLY AGE QUESTION
df <- df_graphs_s3 %>% 
  mutate(STIMULUS = factor(STIMULUS, levels=c("B1-1","B1-2","B1-3","B1-4","B0-0"))) %>% 
  select(PRE_AGE, POST_AGE, STIMULUS, PID) 

### {GGSANKEY} ################################

## REPEATED MEASURES
## SANKEY DIAGRAM
## MUST RESHAPE FOR SANKEY 
ds <- df %>% 
  ##custom from ggsankey
  make_long(PRE_AGE, POST_AGE, value=STIMULUS) %>% 
  mutate(
    node = factor(node, levels=rev(order_age)),
    next_node= factor(next_node,rev(order_age)),
    match = ifelse(node==next_node, 1, 0.5), # try to highlight throughflows
  ) 

(S <- ggplot(ds, aes(x = x, 
               next_x = next_x, 
               node = node, 
               next_node = next_node,
               fill = node
               ))+
  geom_sankey(width = 0.25, flow.alpha = 0.65, node.alpha = 1, node.color = "white") +
  # geom_sankey_text(aes( x = as.numeric(x),  label = after_stat(freq)),
  #         size = 3, color = "white", fontface = "bold", check_overlap = TRUE) +
  scale_fill_manual(values = my_palettes(name="lightblues", direction = "-1"), guide = guide_legend(reverse = TRUE)) +
  labs(title = "CHANGE in AGE by STIMULUS", 
       x = "TIME", y = "(count)", fill = "AGE",
       caption = "") + 
  theme_minimal() + facet_grid(.~value)
)

#############################################


if(GRAPH_SAVE == TRUE) {
    ggsave(plot = S, path="figs/FIG5_Descriptives", filename =paste0("S3_AGE_CHANGE_by_STIMLUS.png"), units = c("in"), width = 16, height = 8,  bg='#ffffff'  )
  }

GENDER

### FILTER FOR ONLY GENDER QUESTION
df <- df_graphs_s3 %>% 
  select(PRE_GENDER, POST_GENDER, STIMULUS, PID) %>% 
  mutate(STIMULUS = factor(STIMULUS, levels=c("B1-1","B1-2","B1-3","B1-4","B0-0")))

### {GGSANKEY} ################################

## REPEATED MEASURES
## SANKEY DIAGRAM
## MUST RESHAPE FOR SANKEY 
ds <- df %>% 
  ##custom from ggsankey
  make_long(PRE_GENDER, POST_GENDER, value=STIMULUS) %>% 
  mutate(
    node = factor(node, levels = rev(order_gender)),
    next_node= factor(next_node, levels = rev(order_gender)),
    match = ifelse(node==next_node, 1, 0.5), # try to highlight throughflows
  ) 

(S <- ggplot(ds, aes(x = x, 
               next_x = next_x, 
               node = node, 
               next_node = next_node,
               fill = node
               ))+
  geom_sankey(width = 0.25, flow.alpha = 0.65, node.alpha = 1, node.color = "white") +
  # geom_sankey_text(aes( x = as.numeric(x),  label = after_stat(freq)),
  #         size = 3, color = "white", fontface = "bold", check_overlap = TRUE) +
  scale_fill_manual(values = my_palettes(name="smallgreens", direction = "-1"), guide = guide_legend(reverse = TRUE)) +
  labs(title = "CHANGE in GENDER by STIMULUS", 
       x = "TIME", y = "(count)", fill = "GENDER",
       caption = "") + 
  theme_minimal() + facet_grid(.~value)
)

#############################################


if(GRAPH_SAVE == TRUE) {
    ggsave(plot = S, path="figs/FIG5_Descriptives", filename =paste0("S3_GENDER_CHANGE_by_STIMLUS.png"), units = c("in"), width = 16, height = 8,  bg='#ffffff'  )
  }

ENCOUNTER

### FILTER FOR ONLY GENDER QUESTION
df <- df_graphs_s3 %>% 
  select(PRE_ENCOUNTER, POST_ENCOUNTER, STIMULUS, PID) %>% 
  mutate(STIMULUS = factor(STIMULUS, levels=c("B1-1","B1-2","B1-3","B1-4","B0-0")))

### {GGSANKEY} ################################

## REPEATED MEASURES
## SANKEY DIAGRAM
## MUST RESHAPE FOR SANKEY 
ds <- df %>% 
  ##custom from ggsankey
  make_long(PRE_ENCOUNTER, POST_ENCOUNTER, value=STIMULUS) %>% 
  mutate(
    node = factor(node, levels = rev(order_encounter)),
    next_node= factor(next_node, levels = rev(order_encounter)),
    match = ifelse(node==next_node, 1, 0.5), # try to highlight throughflows
  ) 

(S <- ggplot(ds, aes(x = x, 
               next_x = next_x, 
               node = node, 
               next_node = next_node,
               fill = node
               ))+
  geom_sankey(width = 0.25, flow.alpha = 0.65, node.alpha = 1, node.color = "white") +
  # geom_sankey_text(aes( x = as.numeric(x),  label = after_stat(freq)),
  #         size = 3, color = "white", fontface = "bold", check_overlap = TRUE) +
  scale_fill_manual(values = my_palettes(name="encounter", direction = "-1"), guide = guide_legend(reverse = TRUE)) +
  labs(title = "CHANGE in ENCOUNTER by STIMULUS", 
       x = "TIME", y = "(count)", fill = "ENCOUNTER",
       caption = "") + 
  theme_minimal() + facet_grid(.~value)
)

#############################################


if(GRAPH_SAVE == TRUE) {
    ggsave(plot = S, path="figs/FIG5_Descriptives", filename =paste0("S3_ENCOUNTER_CHANGE_by_STIMLUS.png"), units = c("in"), width = 16, height = 8,  bg='#ffffff'  )
  }

(4.1.4) Exploratory Factor Analysis

As Reported in Section 4.1.4, and Figure 6, here we conduct an exploratory factor analysis of the short-form semantic differential scale questions for Studies 1 & 2.

This analysis was performed on the combined dataset from Study 1 (Tumblr) and Study 2 (Prolific). Both studies were run on all 6 stimulus blocks, meaning the data are balanced across all stimuli.

We use a parallel analysis method, verified by inspection of the scree plot to determine (f=4) factors, and see that both the KMO measure and Bartlett’s test of sphericity meet the necessary pre-requisites to support this analysis. The resultant factor loadings are described below.

## SETUP DATA
df <- df_graphs_all %>% 
  filter(Study %in% c("Study1","Study2")) 
  # %>% filter(STIMULUS !="B0-0") ## filtering out B0-0 doesn't change factors
  
x <- ref_min_sd_questions_z

# ## SANITY CHECK INCLUDED DDATA
# print("Dataset for EFA")
# addmargins(table(df$Study, df$Assigned.Block)/5)


## RUN EFA JAMOVI STYLE
jmv::efa(
    data = df,
    vars = as.vector(x),
    # nFactors = 3,
    extraction = "ml",
    sortLoadings = FALSE,
    screePlot = TRUE,
    eigen = FALSE,
    factorCor = TRUE,
    factorSummary = TRUE,
    modelFit = TRUE,
    kmo = TRUE,
    bartlett = TRUE)
## Loading required namespace: GPArotation
## 
##  EXPLORATORY FACTOR ANALYSIS
## 
##  Factor Loadings                                                         
##  ─────────────────────────────────────────────────────────────────────── 
##                  1             2             3             Uniqueness    
##  ─────────────────────────────────────────────────────────────────────── 
##    DESIGN_z                     0.9985577                  0.004999781   
##    DATA_z                                     0.5598365    0.576833782   
##    POLITICS_z    -0.5702053                                0.716034927   
##    TRUST_z        0.5248731                  -0.4350605    0.341614895   
##    ALIGN_z        0.8943077                                0.207654559   
##    BEAUTY_z       0.3697155    -0.3581471                  0.689074511   
##    INTENT_z                                   0.6250459    0.586348044   
##  ─────────────────────────────────────────────────────────────────────── 
##    Note. 'Maximum likelihood' extraction method was used in
##    combination with a 'oblimin' rotation
## 
## 
##  FACTOR STATISTICS
## 
##  Summary                                                    
##  ────────────────────────────────────────────────────────── 
##    Factor    SS Loadings    % of Variance    Cumulative %   
##  ────────────────────────────────────────────────────────── 
##    1           1.6251834         23.21691        23.21691   
##    2           1.2636405         18.05201        41.26891   
##    3           0.9886156         14.12308        55.39199   
##  ────────────────────────────────────────────────────────── 
## 
## 
##  Inter-Factor Correlations              
##  ────────────────────────────────────── 
##         1    2             3            
##  ────────────────────────────────────── 
##    1    —    -0.1106452    -0.4111987   
##    2                  —     0.1962376   
##    3                                —   
##  ────────────────────────────────────── 
## 
## 
##  MODEL FIT
## 
##  Model Fit Measures                                                                                  
##  ─────────────────────────────────────────────────────────────────────────────────────────────────── 
##    RMSEA         Lower         Upper         TLI          BIC          χ²          df    p           
##  ─────────────────────────────────────────────────────────────────────────────────────────────────── 
##    0.05470698    0.03157684    0.08101075    0.9622353    -4.836669    17.27780     3    0.0006196   
##  ─────────────────────────────────────────────────────────────────────────────────────────────────── 
## 
## 
##  ASSUMPTION CHECKS
## 
##  Bartlett's Test of Sphericity    
##  ──────────────────────────────── 
##    χ²          df    p            
##  ──────────────────────────────── 
##    2670.879    21    < .0000001   
##  ──────────────────────────────── 
## 
## 
##  KMO Measure of Sampling Adequacy 
##  ──────────────────────────────── 
##                  MSA         
##  ──────────────────────────────── 
##    Overall       0.6718293   
##    DESIGN_z      0.5239764   
##    DATA_z        0.6237950   
##    POLITICS_z    0.7215156   
##    TRUST_z       0.7187961   
##    ALIGN_z       0.6788071   
##    BEAUTY_z      0.7146919   
##    INTENT_z      0.6808428   
##  ────────────────────────────────

(4.2) Predicting Trust

In this section we describe a series of linear mixed effects models constructed to explore the relationship between trust, beauty and social attributions, as reported in section 4.2. Specifically, we test the hypotheses that 3 variables related to a visualization maker’s intent and competency (INTENT, ALIGNment, DATA skill) influence the relationship between beauty and trust.

SETUP MODEL DATA

This model includes data from Studies 1&2, as Study 3 used a pre-post design

df <- df_graphs_all %>% 
  # filter only Study 1 and 2
  filter(Study %in% c("Study1","Study2"))

# ## SANITY CHECK DATA IN MODEL
# print("Data in Model")
# table(df$Study, df$Assigned.Block)

M1 | TRUST ~ BEAUTY (REPORT FOR COMPARISON)

We begin by fitting a linear mixed effects, model predicting CHART_TRUST by CHART_BEAUTY to see whether our data support the claims made by Lin & Thorton, 2021.

  • (CHART_TRUST 0 = not at all untrustworthy, 100 = very trustworthy)

  • (CHART_BEAUTY 0 = not at all aesthetically pleasing , 100 = very aesthetically pleasing)

################## FIT MODEL
f.B <-  "TRUST ~ BEAUTY + (1|PID)"
mm.B <- lmer(TRUST_z ~ BEAUTY_z + (1|PID), data = df)
summary(mm.B)
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: TRUST_z ~ BEAUTY_z + (1 | PID)
##    Data: df
## 
## REML criterion at convergence: 4262.3
## 
## Scaled residuals: 
##    Min     1Q Median     3Q    Max 
## -4.264 -0.513  0.015  0.571  3.254 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev.
##  PID      (Intercept) 0.09881  0.3143  
##  Residual             0.76949  0.8772  
## Number of obs: 1590, groups:  PID, 318
## 
## Fixed effects:
##               Estimate Std. Error         df t value Pr(>|t|)    
## (Intercept)   -0.01038    0.02819  315.51564  -0.368    0.713    
## BEAUTY_z       0.35186    0.02300 1548.61812  15.295   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##          (Intr)
## BEAUTY_z -0.018
car::Anova(mm.B, type=2)
## Analysis of Deviance Table (Type II Wald chisquare tests)
## 
## Response: TRUST_z
##           Chisq Df Pr(>Chisq)    
## BEAUTY_z 233.94  1  < 2.2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
performance(mm.B)
## # Indices of model performance
## 
## AIC      |     AICc |      BIC | R2 (cond.) | R2 (marg.) |   ICC |  RMSE | Sigma
## --------------------------------------------------------------------------------
## 4270.325 | 4270.350 | 4291.811 |      0.224 |      0.124 | 0.114 | 0.842 | 0.877
################## PLOT MODEL
## PLOT MODEL COEFFICIENTS
e <- plot_model(mm.B, type = "est", show.intercept = TRUE,show.p=TRUE, show.values = TRUE) + labs(title = "Model Coefficients") + theme_minimal()
## PLOT MODEL PREDICTIONS
p <- plot_model(mm.B, type = "pred", terms = "BEAUTY_z") +  theme_minimal()
(g <- (e+p) + plot_annotation(title = f.B))

A model predicting TRUST by BEAUTY explains 22% variance in CHART_TRUST, with 12% variance explained by a significant main effect of BEAUTY (\(t(1548) = 15.30, p < .001\)). The model coefficient indicates that for every 1 standard deviation increase in BEAUTY, CHART-TRUST increases on average by 0.35 SD.

Model 1 supports the argument of Lin & Thorton (2021) that graphs judged to be more attractive are also judged as more trustworthy.

M2 | TRUST ~ BEAUTY + INTENT

Here we add a main effect term INTENT as a predictor to the previous model and compare fit with Model 1, to determine whether a social attribution (in this case inference about the maker’s intent) is also predictive of TRUST.

  • (CHART_TRUST 0 = not at all untrustworthy, 100 = very trustworthy)

  • (CHART_BEAUTY 0 = not at all aesthetically pleasing , 100 = very aesthetically pleasing)

  • (CHART_INTENT 0 = to inform , 100 = persuade)

################## FIT MODEL
f.BI <-  "TRUST ~ BEAUTY + INTENT + (1|PID)"
mm.BI <- lmer(TRUST_z ~ BEAUTY_z + INTENT_z + (1|PID), data = df)
summary(mm.BI)
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: TRUST_z ~ BEAUTY_z + INTENT_z + (1 | PID)
##    Data: df
## 
## REML criterion at convergence: 3944.1
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -4.1262 -0.5655 -0.0193  0.5750  3.2743 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev.
##  PID      (Intercept) 0.09258  0.3043  
##  Residual             0.62015  0.7875  
## Number of obs: 1590, groups:  PID, 318
## 
## Fixed effects:
##               Estimate Std. Error         df t value Pr(>|t|)    
## (Intercept) -8.304e-03  2.610e-02  3.149e+02  -0.318    0.751    
## BEAUTY_z     3.051e-01  2.088e-02  1.540e+03  14.616   <2e-16 ***
## INTENT_z    -4.001e-01  2.109e-02  1.584e+03 -18.971   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##          (Intr) BEAUTY
## BEAUTY_z -0.018       
## INTENT_z -0.004  0.115
car::Anova(mm.BI, type=2)
## Analysis of Deviance Table (Type II Wald chisquare tests)
## 
## Response: TRUST_z
##           Chisq Df Pr(>Chisq)    
## BEAUTY_z 213.61  1  < 2.2e-16 ***
## INTENT_z 359.90  1  < 2.2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
################## COMPARE MODEL
compare_performance(mm.BI, mm.B, rank = TRUE)
## # Comparison of Model Performance Indices
## 
## Name  |           Model | R2 (cond.) | R2 (marg.) |   ICC |  RMSE | Sigma
## -------------------------------------------------------------------------
## mm.BI | lmerModLmerTest |      0.376 |      0.283 | 0.130 | 0.752 | 0.787
## mm.B  | lmerModLmerTest |      0.224 |      0.124 | 0.114 | 0.842 | 0.877
## 
## Name  | AIC weights | AICc weights | BIC weights | Performance-Score
## --------------------------------------------------------------------
## mm.BI |        1.00 |         1.00 |        1.00 |           100.00%
## mm.B  |    9.49e-71 |     9.55e-71 |    1.39e-69 |             0.00%
anova(mm.BI, mm.B)
## refitting model(s) with ML (instead of REML)
## Data: df
## Models:
## mm.B: TRUST_z ~ BEAUTY_z + (1 | PID)
## mm.BI: TRUST_z ~ BEAUTY_z + INTENT_z + (1 | PID)
##       npar    AIC    BIC  logLik deviance  Chisq Df Pr(>Chisq)    
## mm.B     4 4259.3 4280.8 -2125.7   4251.3                         
## mm.BI    5 3936.8 3963.7 -1963.4   3926.8 324.47  1  < 2.2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
################## PLOT MODEL
## PLOT MODEL COEFFICIENTS
e <- plot_model(mm.BI, type = "est", show.intercept = TRUE,show.p=TRUE, show.values = TRUE) + labs(title = "Model Coefficients") + theme_minimal()
## PLOT MODEL PREDICTIONS
p <- plot_model(mm.BI, type = "pred", terms = c("BEAUTY_z", "INTENT_z")) + theme_minimal()
(g <- (e+p) + plot_annotation(title = f.B, caption="low intent = inform, high intent = persuade"))

################## ALT PLOTS
# plot_model(mm.BI, type = "pred", terms = c("BEAUTY_z", "INTENT_z")) + theme_minimal()
# plot_model(mm.BI, type = "pred", terms = c("INTENT_z","BEAUTY_z")) + theme_minimal()

A model predicting TRUST by a linear combination of BEAUTY and INTENT explains 38% variance in TRUST, with 28% variance explained by fixed effects alone:

  1. A significant main effect of BEAUTY (\(t(1540) = 14.62, p <.001\)), and

  2. A significant main effect of INTENT (\(t(1584) = -18.97, p <.001\)).

    The model coefficients indicates that for every 1 standard deviation increase in BEAUTY, TRUST increases on average by 0.3 SD (more beauty corresponds to more trust). For every 1 standard deviation increase in INTENT, (where LOW values correspond to intent to INFORM and high values correspond to intent to PERSUADE) TRUST decreases by 0.4 SD (more persuasive corresponds to less trustworthy).

Further, model comparisons indicate that MODEL 2 (including CHART_INTENT) is a significantly better fit to the data (\(\chi^2(1) = 324 , p < 0.001\)) than MODEL 1 including BEAUTY alone.

Model 2 supports our claim that social attributions (in this case, an inference about the communicative intent of the chart) also predict beauty, above and beyond the beauty-centric argument of Lin & Thorton (2021) that graphs judged to be more attractive are also judged as more trustworthy.

M3 | TRUST ~ BEAUTY X INTENT

Here we fit a model with INTENT as an interaction with BEAUTY, and compare with the previous model (with the simple linear combination of the two predictors) to determine whether simply affecting TRUST, the social attribution of INTENT moderates the effect of BEAUTY on TRUST.

  • (CHART_TRUST 0 = not at all untrustworthy, 100 = very trustworthy)

  • (CHART_BEAUTY 0 = not at all aesthetically pleasing , 100 = very aesthetically pleasing)

  • (CHART_INTENT 0 = to inform , 100 = persuade)

################## FIT MODEL
f.BxI <-  "TRUST ~ BEAUTY X INTENT + (1|PID)"
mm.BxI <- lmer(TRUST_z ~ BEAUTY_z * INTENT_z + (1|PID), data = df)
summary(mm.BxI)
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: TRUST_z ~ BEAUTY_z * INTENT_z + (1 | PID)
##    Data: df
## 
## REML criterion at convergence: 3915.4
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -4.1758 -0.5956 -0.0174  0.5758  3.4158 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev.
##  PID      (Intercept) 0.09333  0.3055  
##  Residual             0.60543  0.7781  
## Number of obs: 1590, groups:  PID, 318
## 
## Fixed effects:
##                     Estimate Std. Error         df t value Pr(>|t|)    
## (Intercept)        4.328e-03  2.606e-02  3.188e+02   0.166    0.868    
## BEAUTY_z           2.995e-01  2.066e-02  1.536e+03  14.495  < 2e-16 ***
## INTENT_z          -3.862e-01  2.100e-02  1.584e+03 -18.390  < 2e-16 ***
## BEAUTY_z:INTENT_z  1.126e-01  1.900e-02  1.566e+03   5.928 3.77e-09 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) BEAUTY_z INTENT
## BEAUTY_z    -0.022                
## INTENT_z     0.005  0.109         
## BEAUTY_:INT  0.082 -0.043    0.113
car::Anova(mm.BxI, type=3)  #type 3 tests for interaction model
## Analysis of Deviance Table (Type III Wald chisquare tests)
## 
## Response: TRUST_z
##                      Chisq Df Pr(>Chisq)    
## (Intercept)         0.0276  1     0.8681    
## BEAUTY_z          210.1141  1  < 2.2e-16 ***
## INTENT_z          338.2009  1  < 2.2e-16 ***
## BEAUTY_z:INTENT_z  35.1383  1  3.071e-09 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
################## COMPARE MODEL
compare_performance(mm.BxI, mm.BI, rank = TRUE)
## # Comparison of Model Performance Indices
## 
## Name   |           Model | R2 (cond.) | R2 (marg.) |   ICC |  RMSE | Sigma
## --------------------------------------------------------------------------
## mm.BxI | lmerModLmerTest |      0.391 |      0.297 | 0.134 | 0.743 | 0.778
## mm.BI  | lmerModLmerTest |      0.376 |      0.283 | 0.130 | 0.752 | 0.787
## 
## Name   | AIC weights | AICc weights | BIC weights | Performance-Score
## ---------------------------------------------------------------------
## mm.BxI |       1.000 |        1.000 |       1.000 |           100.00%
## mm.BI  |    7.51e-08 |     7.57e-08 |    1.10e-06 |             0.00%
anova(mm.BxI, mm.BI)
## refitting model(s) with ML (instead of REML)
## Data: df
## Models:
## mm.BI: TRUST_z ~ BEAUTY_z + INTENT_z + (1 | PID)
## mm.BxI: TRUST_z ~ BEAUTY_z * INTENT_z + (1 | PID)
##        npar    AIC    BIC  logLik deviance  Chisq Df Pr(>Chisq)    
## mm.BI     5 3936.8 3963.7 -1963.4   3926.8                         
## mm.BxI    6 3904.0 3936.3 -1946.0   3892.0 34.808  1  3.638e-09 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
################## PLOT MODEL
## PLOT MODEL COEFFICIENTS
e <- plot_model(mm.BxI, type = "est", show.intercept = TRUE,show.p=TRUE, show.values = TRUE) + labs(title = "Model Coefficients") + theme_minimal()
## PLOT MODEL PREDICTIONS
p <- plot_model(mm.BxI, type = "int", terms = c("INTENT_z","BEAUTY_z"),mdrt.values = "all") + theme_minimal()
(g <- (e+p) + plot_annotation(title = f.BxI, caption="low intent = inform, high intent = persuade", subtitle = f.BxI))

################## ALT PLOTS
# plot_model(mm.BxI, type = "pred", terms = c("BEAUTY_z", "INTENT_z")) + theme_minimal()
# plot_model(mm.BxI, type = "pred", terms = c("INTENT_z","BEAUTY_z")) + theme_minimal()

A model predicting CHART-TRUST by a linear interaction of CHART_BEAUTY and CHART_INTENT explains 40% variance in CHART_TRUST, with 30% variance explained by fixed effects alone:

  1. A significant main effect of CHART_BEAUTY (\(\chi^2(1) = 210, p <.001\))

  2. A significant main effect of CHART_INTENT (\(\chi^2(1) = 338, p <.001\))

  3. A significant interaction between CHART_BEAUTY and CHART_INTENT (\(\chi^2(1) = 35, p <.001\))

    The model coefficients indicates that for every 1 standard deviation increase in CHART-BEAUTY, CHART-TRUST increases on average by 0.3 SD (more beauty corresponds to more trust). For every 1 standard deviation increase in CHART_INTENT, (where LOW values correspond to intent to INFORM and high values correspond to intent to PERSUADE) CHART-TRUST decreases on average by 0.4 SD (more persuasive corresponds to less trust). The significant interaction term indicates the difference in slope between the two main effects, that is to say, that the effect of CHART_BEAUTY on CHART_TRUST is moderated such that the effect of CHART_BEAUTY is minimized when CHART_INTENT is attributed as more informative (lower values of chart_intent) than persuasive (higher values of chart_intent) (Trust increases as a function of beauty MORE for more persuasive intents. The difference in trust for unattractive and attractive images intended to inform is lower. )

Further, model comparisons indicate that MODEL 3 (an interaction rather than MODEL 2 with a linear combination of CHART_BEAUTY and CHART_INTENT) is a significantly better fit to the data (\(\chi^2(1)=34.81 , p < 0.001\)).

Model 3 supports our claim that social attributions (in this case, an inference about the communicative intent of the chart) also predict beauty, and in fact can change (moderate) the effect of beauty on trust.

M4 | TRUST ~ BEAUTY X INTENT + DATA

Here we add MAKER_DATA competency to our previous model to determine whether a viewer’s inferences about the data analysis ability of the chart’s maker affect assesments of the chart’s trustworthiness.

  • (CHART_TRUST 0 = not at all untrustworthy, 100 = very trustworthy)

  • (CHART_BEAUTY 0 = not at all aesthetically pleasing , 100 = very aesthetically pleasing)

  • (CHART_INTENT 0 = to inform , 100 = persuade)

  • (MAKER_DATA 0 = professional in data analysis , 100 = layperson in data analysis)

################## FIT MODEL
f.BxID <-  "TRUST ~ BEAUTY X INTENT + DATA (1|PID)"
mm.BxID <- lmer(TRUST_z ~ BEAUTY_z * INTENT_z + DATA_z + (1|PID), data = df)
summary(mm.BxID)
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: TRUST_z ~ BEAUTY_z * INTENT_z + DATA_z + (1 | PID)
##    Data: df
## 
## REML criterion at convergence: 3865
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -3.9553 -0.5821 -0.0113  0.5773  3.0721 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev.
##  PID      (Intercept) 0.08655  0.2942  
##  Residual             0.58694  0.7661  
## Number of obs: 1590, groups:  PID, 318
## 
## Fixed effects:
##                     Estimate Std. Error         df t value Pr(>|t|)    
## (Intercept)        1.882e-03  2.542e-02  3.186e+02   0.074    0.941    
## BEAUTY_z           2.731e-01  2.063e-02  1.535e+03  13.242  < 2e-16 ***
## INTENT_z          -3.373e-01  2.162e-02  1.585e+03 -15.602  < 2e-16 ***
## DATA_z            -1.645e-01  2.174e-02  1.575e+03  -7.567 6.46e-14 ***
## BEAUTY_z:INTENT_z  1.041e-01  1.871e-02  1.568e+03   5.565 3.08e-08 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) BEAUTY_z INTENT DATA_z
## BEAUTY_z    -0.019                       
## INTENT_z     0.001  0.052                
## DATA_z       0.013  0.172   -0.298       
## BEAUTY_:INT  0.083 -0.032    0.089  0.059
car::Anova(mm.BxID, type=3) #type 3 tests for interaction model
## Analysis of Deviance Table (Type III Wald chisquare tests)
## 
## Response: TRUST_z
##                      Chisq Df Pr(>Chisq)    
## (Intercept)         0.0055  1      0.941    
## BEAUTY_z          175.3494  1  < 2.2e-16 ***
## INTENT_z          243.4132  1  < 2.2e-16 ***
## DATA_z             57.2608  1  3.817e-14 ***
## BEAUTY_z:INTENT_z  30.9710  1  2.619e-08 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
################## COMPARE MODEL
compare_performance(mm.BxID, mm.BxI, rank = TRUE)
## # Comparison of Model Performance Indices
## 
## Name    |           Model | R2 (cond.) | R2 (marg.) |   ICC |  RMSE | Sigma
## ---------------------------------------------------------------------------
## mm.BxID | lmerModLmerTest |      0.408 |      0.321 | 0.129 | 0.732 | 0.766
## mm.BxI  | lmerModLmerTest |      0.391 |      0.297 | 0.134 | 0.743 | 0.778
## 
## Name    | AIC weights | AICc weights | BIC weights | Performance-Score
## ----------------------------------------------------------------------
## mm.BxID |       1.000 |        1.000 |       1.000 |            87.50%
## mm.BxI  |    1.54e-12 |     1.56e-12 |    2.26e-11 |            12.50%
anova(mm.BxID, mm.BxI)
## refitting model(s) with ML (instead of REML)
## Data: df
## Models:
## mm.BxI: TRUST_z ~ BEAUTY_z * INTENT_z + (1 | PID)
## mm.BxID: TRUST_z ~ BEAUTY_z * INTENT_z + DATA_z + (1 | PID)
##         npar    AIC    BIC  logLik deviance  Chisq Df Pr(>Chisq)    
## mm.BxI     6 3904.0 3936.3 -1946.0   3892.0                         
## mm.BxID    7 3849.6 3887.2 -1917.8   3835.6 56.395  1  5.929e-14 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
################## PLOT MODEL
## PLOT MODEL COEFFICIENTS
e <- plot_model(mm.BxID, type = "est", show.intercept = TRUE,show.p=TRUE, show.values = TRUE) + labs(title = "Model Coefficients") + theme_minimal()
## PLOT MODEL PREDICTIONS
p <- plot_model(mm.BxID, type = "pred", terms = c("INTENT_z","DATA_z","BEAUTY_z"))  + theme_minimal()
(g <- (e/p) + plot_annotation(title = f.BxID, caption="low intent = inform, high intent = persuade; low data = professional, high data = layperson", subtitle = f.BxID))

################## ALT PLOTS
# plot_model(mm.BxID, type = "pred", terms = c("BEAUTY_z", "INTENT_z","DATA_z")) + theme_minimal()
# plot_model(mm.BxID, type = "pred", terms = c("INTENT_z","BEAUTY_z","DATA_z")) + theme_minimal()
# plot_model(mm.BxID, type = "pred", terms = c("BEAUTY_z", "DATA_z","INTENT_z"))+ theme_minimal()

A model predicting CHART-TRUST by a linear interaction of CHART_BEAUTY and CHART_INTENT as well as a main effect of MAKER_DATA competency explains 41% variance in CHART_TRUST, with 32% variance explained by fixed effects alone:

  1. A significant main effect of CHART_BEAUTY (\(\chi^2(1) = 175, p <.001\))

  2. A significant main effect of CHART_INTENT (\(\chi^2(1) = 243, p <.001\))

  3. A significant main effect of MAKER_DATA (\(\chi^2(1) = 57, p <.001\))

  4. A significant interaction between CHART_BEAUTY and CHART_INTENT (\(\chi^2(1) = 31, p <.001\))

    The model coefficients indicates that for every 1 standard deviation increase in MAKER_DATA, CHART-TRUST decreases on average by 0.16 SD (less expertise/more layperson corresponds to lower trust). For every 1 standard deviation increase in CHART-BEAUTY, CHART-TRUST increases on average by 0.3 SD (more beauty corresponds to more trust). For every 1 standard deviation increase in CHART_INTENT, (where LOW values correspond to intent to INFORM and high values correspond to intent to PERSUADE) CHART-TRUST decreases on average by 0.3 SD ( persuasive corresponds to less trust; informative corresponds to more trust). The significant interaction term indicates the difference in slope between the main effects for CHART_BEAUTY and CHART_INTENT, that is to say, that the effect of CHART_BEAUTY on CHART_TRUST is moderated such that the effect of CHART_BEAUTY is minimized when CHART_INTENT is attributed as more informative (lower values on chart_intent) than persuasive (higher values on chart_intent)

Further, model comparisons indicate that MODEL 4 (adding a simple main effect of MAKER_DATA) is a significantly better fit to the data than MODEL 3 without the MAKER_DATA fixed effect (\(\chi^2(1)=56.4 , p < 0.001\)) .

Model 4 supports our claim that social attributions (in this case, both an inference about the communicative intent of the chart and inference about the data analysis skill of the maker) also predict beauty, and in fact can change (in the case of intent, moderate) the effect of beauty on trust.

M5 | TRUST ~ BEAUTY X INTENT X DATA

Here we add an interaction with MAKER_DATA competency to our previous model to determine whether a viewer’s inferences about the data analysis ability of the chart’s maker MODERATE the effects of INTENT and BEAUTY on assesments of trustworthiness.

  • (CHART_TRUST 0 = not at all untrustworthy, 100 = very trustworthy)

  • (CHART_BEAUTY 0 = not at all aesthetically pleasing , 100 = very aesthetically pleasing)

  • (CHART_INTENT 0 = to inform , 100 = persuade)

  • (MAKER_DATA 0 = professional in data analysis , 100 = layperson in data analysis)

################## FIT MODEL
f.BxIxD <-  "TRUST ~ BEAUTY X INTENT X DATA (1|PID)"
mm.BxIxD <- lmer(TRUST_z ~ BEAUTY_z * INTENT_z * DATA_z + (1|PID), data = df)
summary(mm.BxIxD)
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: TRUST_z ~ BEAUTY_z * INTENT_z * DATA_z + (1 | PID)
##    Data: df
## 
## REML criterion at convergence: 3878.2
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -3.8950 -0.5852 -0.0185  0.5869  2.9601 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev.
##  PID      (Intercept) 0.08781  0.2963  
##  Residual             0.58529  0.7650  
## Number of obs: 1590, groups:  PID, 318
## 
## Fixed effects:
##                            Estimate Std. Error         df t value Pr(>|t|)    
## (Intercept)               1.358e-02  2.629e-02  3.517e+02   0.516   0.6058    
## BEAUTY_z                  2.756e-01  2.139e-02  1.530e+03  12.885  < 2e-16 ***
## INTENT_z                 -3.403e-01  2.184e-02  1.582e+03 -15.581  < 2e-16 ***
## DATA_z                   -1.676e-01  2.195e-02  1.572e+03  -7.637 3.83e-14 ***
## BEAUTY_z:INTENT_z         9.515e-02  1.970e-02  1.553e+03   4.830 1.50e-06 ***
## BEAUTY_z:DATA_z           6.497e-03  1.998e-02  1.578e+03   0.325   0.7451    
## INTENT_z:DATA_z          -4.248e-02  2.026e-02  1.563e+03  -2.097   0.0362 *  
## BEAUTY_z:INTENT_z:DATA_z -2.032e-02  1.714e-02  1.565e+03  -1.186   0.2358    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##                  (Intr) BEAUTY_z INTENT_z DATA_z BEAUTY_z:INTENT_ BEAUTY_:D
## BEAUTY_z         -0.036                                                    
## INTENT_z          0.009  0.018                                             
## DATA_z            0.017  0.147   -0.274                                    
## BEAUTY_z:INTENT_  0.010 -0.037    0.076    0.040                           
## BEAUTY_:DAT       0.105  0.064    0.044    0.095 -0.259                    
## INTENT_:DAT      -0.201  0.039    0.032    0.063  0.152            0.099   
## BEAUTY_:INTENT_:  0.008 -0.245    0.137    0.098  0.044           -0.049   
##                  INTENT_:
## BEAUTY_z                 
## INTENT_z                 
## DATA_z                   
## BEAUTY_z:INTENT_         
## BEAUTY_:DAT              
## INTENT_:DAT              
## BEAUTY_:INTENT_:  0.241
car::Anova(mm.BxIxD, type=3) #type 3 tests for interaction model
## Analysis of Deviance Table (Type III Wald chisquare tests)
## 
## Response: TRUST_z
##                             Chisq Df Pr(>Chisq)    
## (Intercept)                0.2667  1     0.6055    
## BEAUTY_z                 166.0242  1  < 2.2e-16 ***
## INTENT_z                 242.7586  1  < 2.2e-16 ***
## DATA_z                    58.3287  1  2.218e-14 ***
## BEAUTY_z:INTENT_z         23.3297  1  1.365e-06 ***
## BEAUTY_z:DATA_z            0.1057  1     0.7451    
## INTENT_z:DATA_z            4.3971  1     0.0360 *  
## BEAUTY_z:INTENT_z:DATA_z   1.4063  1     0.2357    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
################## COMPARE MODEL
compare_performance(mm.BxIxD, mm.BxID, rank = TRUE)
## # Comparison of Model Performance Indices
## 
## Name     |           Model | R2 (cond.) | R2 (marg.) |   ICC |  RMSE | Sigma
## ----------------------------------------------------------------------------
## mm.BxIxD | lmerModLmerTest |      0.411 |      0.323 | 0.130 | 0.730 | 0.765
## mm.BxID  | lmerModLmerTest |      0.408 |      0.321 | 0.129 | 0.732 | 0.766
## 
## Name     | AIC weights | AICc weights | BIC weights | Performance-Score
## -----------------------------------------------------------------------
## mm.BxIxD |       0.393 |        0.385 |    2.05e-04 |            62.50%
## mm.BxID  |       0.607 |        0.615 |       1.000 |            37.50%
anova(mm.BxIxD, mm.BxID)
## refitting model(s) with ML (instead of REML)
## Data: df
## Models:
## mm.BxID: TRUST_z ~ BEAUTY_z * INTENT_z + DATA_z + (1 | PID)
## mm.BxIxD: TRUST_z ~ BEAUTY_z * INTENT_z * DATA_z + (1 | PID)
##          npar    AIC    BIC  logLik deviance  Chisq Df Pr(>Chisq)
## mm.BxID     7 3849.6 3887.2 -1917.8   3835.6                     
## mm.BxIxD   10 3850.5 3904.2 -1915.3   3830.5 5.1278  3     0.1627
################## PLOT MODEL
## PLOT MODEL COEFFICIENTS
# e <- plot_model(mm.BxIxD, type = "est", show.intercept = TRUE, show.p=TRUE, show.values = TRUE) + labs(title = "Model Coefficients") + theme_minimal()
# ## PLOT MODEL PREDICTIONS
# p <- plot_model(mm.BxIxD, type = "pred", terms = c("BEAUTY_z","INTENT_z", "DATA_z")) + theme_minimal()
# (g <- (e/p) + plot_annotation(title = f.BxID, caption="low intent = inform, high intent = persuade; low data = professional, high data = layperson", subtitle = f.BxIxD))


################## ALT PLOTS
# plot_model(mm.BxIxD, type = "pred", terms = c("INTENT_z", "BEAUTY_z")) + theme_minimal() + labs(subtitle ="sig ixn beauty x intent")
# plot_model(mm.BxIxD, type = "pred", terms = c("INTENT_z", "DATA_z")) + theme_minimal() + labs(subtitle ="sig ixn data x intent")
# plot_model(mm.BxIxD, type = "pred", terms = c("BEAUTY_z", "DATA_z")) + theme_minimal() + labs(subtitle ="NO IXN BEAUTY x DATA")
# plot_model(mm.BxIxD, type = "pred", terms = c("BEAUTY_z","DATA_z", "INTENT_z")) + theme_minimal()

Here we see that the three-way interaction between BEAUTY X INTENT X DATA is not statistically significant. (\(\chi^2(1) = 1.4, p =0.24\)). There is a significant 2-way interaction between INTENT & DATA, such that increased DATA competency (low data values) lessen the effect of intent on trust. However there is NOT a significant interaction between DATA and BEAUTY (the maker’s skill in data analysis does not affect the relationship between beauty and trust)

The more complicated model is not a significantly better fit, and so we keep the simpler model (no three-way interaction). (\(\chi^2(3)=5.13 , p = 0.16\)) .

M6 | TRUST ~ BEAUTY X INTENT + DATA + ALIGN

Here we add a main effect of ALIGNMENT to our previous model to determine whether a viewer’s attitudes about how the maker’s values align with their own affect assesments of trustworthiness.

  • (CHART_TRUST 0 = not at all untrustworthy, 100 = very trustworthy)

  • (CHART_BEAUTY 0 = not at all aesthetically pleasing , 100 = very aesthetically pleasing)

  • (CHART_INTENT 0 = to inform , 100 = persuade)

  • (MAKER_DATA 0 = professional in data analysis , 100 = layperson in data analysis)

  • (ALIGN 0 = does NOTshare my values , 100 = DOES SHARE my values)

################## FIT MODEL
f.BxIDA <-  "TRUST ~ BEAUTY X INTENT + DATA + ALIGN (1|PID)"
mm.BxIDA <- lmer(TRUST_z ~ BEAUTY_z * INTENT_z + DATA_z + ALIGN_z + (1|PID), data = df)
summary(mm.BxIDA)
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: TRUST_z ~ BEAUTY_z * INTENT_z + DATA_z + ALIGN_z + (1 | PID)
##    Data: df
## 
## REML criterion at convergence: 3342.8
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -3.5904 -0.5572 -0.0499  0.5320  5.2784 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev.
##  PID      (Intercept) 0.07244  0.2691  
##  Residual             0.41451  0.6438  
## Number of obs: 1590, groups:  PID, 318
## 
## Fixed effects:
##                     Estimate Std. Error         df t value Pr(>|t|)    
## (Intercept)       -5.216e-03  2.218e-02  3.187e+02  -0.235    0.814    
## BEAUTY_z           1.084e-01  1.860e-02  1.520e+03   5.832 6.69e-09 ***
## INTENT_z          -2.315e-01  1.878e-02  1.580e+03 -12.325  < 2e-16 ***
## DATA_z            -1.647e-01  1.838e-02  1.566e+03  -8.960  < 2e-16 ***
## ALIGN_z            4.754e-01  1.897e-02  1.541e+03  25.053  < 2e-16 ***
## BEAUTY_z:INTENT_z  7.541e-02  1.586e-02  1.558e+03   4.755 2.17e-06 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) BEAUTY_z INTENT DATA_z ALIGN_
## BEAUTY_z    -0.013                              
## INTENT_z    -0.002 -0.032                       
## DATA_z       0.012  0.161   -0.291              
## ALIGN_z     -0.013 -0.351    0.226 -0.002       
## BEAUTY_:INT  0.081 -0.004    0.072  0.060 -0.073
car::Anova(mm.BxIDA, type=3) #type 3 tests for interaction model
## Analysis of Deviance Table (Type III Wald chisquare tests)
## 
## Response: TRUST_z
##                      Chisq Df Pr(>Chisq)    
## (Intercept)         0.0553  1     0.8141    
## BEAUTY_z           34.0090  1  5.486e-09 ***
## INTENT_z          151.9023  1  < 2.2e-16 ***
## DATA_z             80.2863  1  < 2.2e-16 ***
## ALIGN_z           627.6728  1  < 2.2e-16 ***
## BEAUTY_z:INTENT_z  22.6114  1  1.983e-06 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
################## COMPARE MODEL
compare_performance(mm.BxIDA, mm.BxID, rank = TRUE)
## # Comparison of Model Performance Indices
## 
## Name     |           Model | R2 (cond.) | R2 (marg.) |   ICC |  RMSE | Sigma
## ----------------------------------------------------------------------------
## mm.BxIDA | lmerModLmerTest |      0.581 |      0.508 | 0.149 | 0.612 | 0.644
## mm.BxID  | lmerModLmerTest |      0.408 |      0.321 | 0.129 | 0.732 | 0.766
## 
## Name     | AIC weights | AICc weights | BIC weights | Performance-Score
## -----------------------------------------------------------------------
## mm.BxIDA |        1.00 |         1.00 |        1.00 |           100.00%
## mm.BxID  |   2.24e-115 |    2.27e-115 |   3.29e-114 |             0.00%
anova(mm.BxIDA, mm.BxID)
## refitting model(s) with ML (instead of REML)
## Data: df
## Models:
## mm.BxID: TRUST_z ~ BEAUTY_z * INTENT_z + DATA_z + (1 | PID)
## mm.BxIDA: TRUST_z ~ BEAUTY_z * INTENT_z + DATA_z + ALIGN_z + (1 | PID)
##          npar    AIC    BIC  logLik deviance  Chisq Df Pr(>Chisq)    
## mm.BxID     7 3849.6 3887.2 -1917.8   3835.6                         
## mm.BxIDA    8 3321.7 3364.6 -1652.8   3305.7 529.98  1  < 2.2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
################## PLOT MODEL
## PLOT MODEL COEFFICIENTS
e <- plot_model(mm.BxIDA, type = "est", show.intercept = TRUE, show.p=TRUE, show.values = TRUE) + labs(title = "Model Coefficients") + theme_minimal()
## PLOT MODEL PREDICTIONS
p1 <- plot_model(mm.BxIDA, type = "pred", terms = c("BEAUTY_z","INTENT_z")) + theme_minimal()
p2 <- plot_model(mm.BxIDA, type = "pred", terms = c("DATA_z","ALIGN_z")) + theme_minimal()
(g <- (e/p1/p2) + plot_annotation(title = f.BxIDA, caption="low intent = inform, high intent = persuade; low data = professional, high data = layperson", subtitle = f.BxIDA))

## see each two-way interaction
# plot_model(mm.BxIxD, type = "pred", terms = c("INTENT_z", "BEAUTY_z")) + theme_minimal() + labs(subtitle ="sig ixn beauty x intent")
# plot_model(mm.BxIxD, type = "pred", terms = c("INTENT_z", "DATA_z")) + theme_minimal() + labs(subtitle ="sig ixn data x intent")
# plot_model(mm.BxIxD, type = "pred", terms = c("BEAUTY_z", "DATA_z")) + theme_minimal() + labs(subtitle ="NO IXN BEAUTY x DATA")

A model predicting CHART-TRUST by a linear combination of maker ALIGNment with DATA competency and an interaction of CHART_BEAUTY and CHART_INTENT as explains 58% variance in CHART_TRUST, with 51% variance explained by fixed effects alone:

  1. A significant main effect of CHART_BEAUTY (\(\chi^2(1) = 34, p <.001\))

  2. A significant main effect of CHART_INTENT (\(\chi^2(1) = 152, p <.001\))

  3. A significant main effect of MAKER_DATA (\(\chi^2(1) = 80, p <.001\))

  4. A significant main effect of MAKER_ALIGN (\(\chi^2(1) = 628, p <.001\))

  5. A significant interaction between CHART_BEAUTY and CHART_INTENT (\(\chi^2(1) = 31, p <.001\))

    The model standardized beta coefficients indicates that for every 1 standard deviation increase MAKER_DATA (more layperson, less professional), CHART-TRUST decreases on average by 0.17 SD (less professional corresponds with less trust). For every in 1 standard deviation increase in MAKER_ALIGN (more values shared) CHART-TRUST increases on average by 0.5 SD (more alignment corresponds with more trust). For every 1 standard deviation increase in CHART_INTENT, (where LOW values correspond to intent to INFORM and high values correspond to intent to PERSUADE) CHART-TRUST decreases on average by 0.23 SD ( persuasive corresponds to less trust; informative corresponds to more trust). And for every in 1 standard deviation increase in CHART_BEAUTY trustworthiness increases by 0.2 SD on average. The significant interaction term indicates the difference in slope between the main effects for CHART_BEAUTY and CHART_INTENT, that is to say, that the effect of CHART_BEAUTY on CHART_TRUST is moderated such that the effect of CHART_BEAUTY is minimized when CHART_INTENT is attributed as more informative (lower values on chart_intent) than persuasive (higher values on chart_intent)

Further, model comparisons indicate that MODEL 6 (adding a simple main effect of MAKER_ALIGN) is a significantly better fit to the data than MODEL 4 without the fixed effect (\(\chi^2(1)= 529 , p < 0.001\)) .

Model 6 supports our claim that social attributions (in this case, both an inference about the communicative intent of the chart and inference about the data analysis skill of the maker and the extent to which the maker’s values align with the participants’) also predict beauty, and in fact can change (in the case of intent, moderate) the effect of beauty on trust.

M7 | TRUST ~ BEAUTY X INTENT + INTENT X ALIGN + DATA

  1. ALIGNMENT moderates INTENT (more alignment mitigates differences in trust based on intent; the more aligned the values are the less difference there is in trust based on intent to inform vs. to persuade) 2.

  2. INTENT moderates BEAUTY (more beauty mitigates differences in trust based on intent; the more beautiful the less difference there is in trust based on intent to inform or persuade)

  3. MAIN EFFECT DATA (less professional => less trustworthy)

  4. MAIN EFFECT INTENT (more persuasive => less trustworthy)

  5. MAIN EFFECT ALIGNMENT (more aligned => more trustworthy)

  6. MAIN EFFECT BEAUTY (more beautify => more trustworthy)

Here we add ALIGNMENT as an interaction term to our previous model to determine whether a viewer’s attitudes about how the maker’s values align with their own might moderate the effects of intent and beauty on assesments of trustworthiness.

  • (CHART_TRUST 0 = not at all untrustworthy, 100 = very trustworthy)

  • (CHART_BEAUTY 0 = not at all aesthetically pleasing , 100 = very aesthetically pleasing)

  • (CHART_INTENT 0 = to inform , 100 = persuade)

  • (MAKER_DATA 0 = professional in data analysis , 100 = layperson in data analysis)

  • (ALIGN 0 = does NOTshare my values , 100 = DOES SHARE my values)

################## FIT MODEL
f.BxIxAD <-  "TRUST ~ BEAUTY X INTENT + INTENT X ALIGN + DATA + (1|PID)"
mm.BxIxAD <- lmer(TRUST_z ~ BEAUTY_z * INTENT_z + INTENT_z*ALIGN_z + DATA_z + (1|PID), data = df)
summary(mm.BxIxAD)
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: TRUST_z ~ BEAUTY_z * INTENT_z + INTENT_z * ALIGN_z + DATA_z +  
##     (1 | PID)
##    Data: df
## 
## REML criterion at convergence: 3339
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -3.6647 -0.5594 -0.0526  0.5321  4.9381 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev.
##  PID      (Intercept) 0.07417  0.2723  
##  Residual             0.41086  0.6410  
## Number of obs: 1590, groups:  PID, 318
## 
## Fixed effects:
##                     Estimate Std. Error         df t value Pr(>|t|)    
## (Intercept)        6.535e-03  2.255e-02  3.324e+02   0.290  0.77214    
## BEAUTY_z           1.088e-01  1.853e-02  1.517e+03   5.869 5.39e-09 ***
## INTENT_z          -2.269e-01  1.878e-02  1.578e+03 -12.081  < 2e-16 ***
## ALIGN_z            4.634e-01  1.927e-02  1.543e+03  24.049  < 2e-16 ***
## DATA_z            -1.651e-01  1.832e-02  1.563e+03  -9.013  < 2e-16 ***
## BEAUTY_z:INTENT_z  5.428e-02  1.713e-02  1.536e+03   3.168  0.00157 ** 
## INTENT_z:ALIGN_z   5.148e-02  1.607e-02  1.560e+03   3.204  0.00138 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) BEAUTY_z INTENT_z ALIGN_ DATA_z BEAUTY_:
## BEAUTY_z    -0.011                                         
## INTENT_z     0.011 -0.031                                  
## ALIGN_z     -0.044 -0.346    0.206                         
## DATA_z       0.011  0.161   -0.291    0.000                
## BEAUTY_:INT  0.011 -0.007    0.037    0.008  0.059         
## INTENT_:ALI  0.162  0.008    0.077   -0.192 -0.009 -0.386
car::Anova(mm.BxIxAD, type=3) #type 3 tests for interaction model
## Analysis of Deviance Table (Type III Wald chisquare tests)
## 
## Response: TRUST_z
##                     Chisq Df Pr(>Chisq)    
## (Intercept)         0.084  1   0.771962    
## BEAUTY_z           34.440  1  4.395e-09 ***
## INTENT_z          145.956  1  < 2.2e-16 ***
## ALIGN_z           578.346  1  < 2.2e-16 ***
## DATA_z             81.228  1  < 2.2e-16 ***
## BEAUTY_z:INTENT_z  10.036  1   0.001535 ** 
## INTENT_z:ALIGN_z   10.265  1   0.001356 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
################## COMPARE MODEL
compare_performance(mm.BxIxAD, mm.BxIDA, mm.BxID, rank = TRUE)
## # Comparison of Model Performance Indices
## 
## Name      |           Model | R2 (cond.) | R2 (marg.) |   ICC |  RMSE | Sigma
## -----------------------------------------------------------------------------
## mm.BxIxAD | lmerModLmerTest |      0.585 |      0.511 | 0.153 | 0.609 | 0.641
## mm.BxIDA  | lmerModLmerTest |      0.581 |      0.508 | 0.149 | 0.612 | 0.644
## mm.BxID   | lmerModLmerTest |      0.408 |      0.321 | 0.129 | 0.732 | 0.766
## 
## Name      | AIC weights | AICc weights | BIC weights | Performance-Score
## ------------------------------------------------------------------------
## mm.BxIxAD |       0.984 |        0.984 |       0.808 |           100.00%
## mm.BxIDA  |       0.016 |        0.016 |       0.192 |            62.67%
## mm.BxID   |   3.59e-117 |    3.67e-117 |   6.34e-115 |             0.00%
anova(mm.BxIxAD, mm.BxIDA)
## refitting model(s) with ML (instead of REML)
## Data: df
## Models:
## mm.BxIDA: TRUST_z ~ BEAUTY_z * INTENT_z + DATA_z + ALIGN_z + (1 | PID)
## mm.BxIxAD: TRUST_z ~ BEAUTY_z * INTENT_z + INTENT_z * ALIGN_z + DATA_z + (1 | PID)
##           npar    AIC    BIC  logLik deviance Chisq Df Pr(>Chisq)   
## mm.BxIDA     8 3321.7 3364.6 -1652.8   3305.7                       
## mm.BxIxAD    9 3313.4 3361.8 -1647.7   3295.4 10.24  1   0.001375 **
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
################## PLOT MODEL
## PLOT MODEL COEFFICIENTS
e <- plot_model(mm.BxIxAD, type = "est", show.intercept = TRUE, show.p=TRUE, show.values = TRUE) + labs(title = "Model Coefficients") + theme_minimal()
## PLOT MODEL PREDICTIONS
p1 <- plot_model(mm.BxIxAD, type = "pred", terms = c("BEAUTY_z","INTENT_z","DATA_z")) + theme_minimal()
p2 <- plot_model(mm.BxIxAD, type = "pred", terms = c("ALIGN_z","INTENT_z","DATA_z")) + theme_minimal()
(g <- (e/p1/p2) + plot_annotation(title = f.BxIxAD, caption="low intent = inform, high intent = persuade; low data = professional, high data = layperson", subtitle = f.BxIxAD))

## alternative plots 
# print("two-way interaction")
# plot_model(mm.BxIxAD, type = "pred", terms = c("BEAUTY_z", "INTENT_z")) + theme_minimal() + labs(subtitle ="sig ixn intent x beauty", caption="INTENT matters MORE less beautiful")
# plot_model(mm.BxIxAD, type = "pred", terms = c("ALIGN_z", "INTENT_z")) + theme_minimal() + labs(subtitle ="sig ixn intent align")
#                                                                                                 
# plot_model(mm.BxIxAD, type = "pred", terms = c("INTENT_z","ALIGN_z")) + theme_minimal() 
# 
# plot_model(mm.BxIxAD, type = "pred", terms = c("BEAUTY_z", "ALIGN_z")) + theme_minimal() + labs(subtitle ="NO IXN beauty align", caption = "MAIN EFFECT ALIGN; more aligned more trustworthy")
# plot_model(mm.BxIxAD, type = "pred", terms = c("BEAUTY_z", "DATA_z")) + theme_minimal() + labs(subtitle ="MAIN EFFECT DATA", caption = "MAIN EFFECT DATA; more professional = more trustworthy")
# 
# ## plot all combinations
# plot_model(mm.BxIxAD, type = "pred", terms = c("BEAUTY_z","INTENT_z","ALIGN_z")) + theme_minimal() # facet align
# plot_model(mm.BxIxAD, type = "pred", terms = c("BEAUTY_z","ALIGN_z","INTENT_z")) + theme_minimal() # facet intent
# 
# plot_model(mm.BxIxAD, type = "pred", terms = c("ALIGN_z","INTENT_z","BEAUTY_z")) + theme_minimal() # facet intent
# plot_model(mm.BxIxAD, type = "pred", terms = c("ALIGN_z","BEAUTY_z","INTENT_z")) + theme_minimal() # facet intent
# 
# plot_model(mm.BxIxAD, type = "pred", terms = c("INTENT_z","BEAUTY_z","ALIGN_z")) + theme_minimal() # facet intent
# plot_model(mm.BxIxAD, type = "pred", terms = c("INTENT_z","ALIGN_z","BEAUTY_z")) + theme_minimal() # facet intent
# 


### PLOT WITH DATA EFFECT 
plot_model(mm.BxIxAD, type = "pred", terms = c("BEAUTY_z","INTENT_z","ALIGN_z","DATA_z")) + theme_minimal() # facet align

plot_model(mm.BxIxAD, type = "pred", terms = c("BEAUTY_z","ALIGN_z","INTENT_z","DATA_z")) + theme_minimal() # facet intent

A model predicting CHART-TRUST explains 59% variance in CHART_TRUST, with 51% variance explained by fixed effects alone:

  1. A significant main effect of CHART_BEAUTY (\(\chi^2(1) = 34, p <.001\)) For every in 1 standard deviation increase in CHART_BEAUTY trustworthiness increases by 0.1 SD on average.

  2. A significant main effect of CHART_INTENT (\(\chi^2(1) = 146, p <.001\)). For every 1 standard deviation increase in CHART_INTENT, (where LOW values correspond to intent to INFORM and high values correspond to intent to PERSUADE) CHART-TRUST decreases on average by 0.23 SD ( persuasive corresponds to less trust; informative corresponds to more trust).

  3. A significant main effect of MAKER_ALIGN (\(\chi^2(1) = 578, p <.001\)). For every in 1 standard deviation increase in MAKER_ALIGN (more values shared) CHART-TRUST increases on average by 0.5 SD (more alignment corresponds with more trust).

  4. A significant main effect of MAKER_DATA (\(\chi^2(1) = 81, p <.001\)). The model standardized beta coefficients indicates that for every 1 standard deviation increase MAKER_DATA (more layperson, less professional), CHART-TRUST decreases on average by 0.17 SD (less professional corresponds with less trust).

  5. A significant interaction between CHART_BEAUTY and CHART_INTENT (\(\chi^2(1) = 31, p <.001\)). The significant interaction term indicates the difference in slope between the main effects for CHART_BEAUTY and CHART_INTENT, that is to say, that the effect of CHART_BEAUTY on CHART_TRUST is moderated such that the effect of CHART_BEAUTY is minimized when CHART_INTENT is attributed as more informative (lower values on chart_intent) than persuasive (higher values on chart_intent)

  6. A significant interaction between CHART_INTENT and CHART_ALIGN (\(\chi^2(1) = 31, p <.001\)) The significant interaction term indicates that the difference in slope between the main effects for CHART_INTENT and MAKER_ALIGN, that is to say that the effect of intent on trust is moderated such that the effect of intent on trust is minimized the the more aligned a viewer feels with the maker. For less alignment, there is a greater difference in trust for persuasive vs. informative images; when the alignment is high, the trustworthiness of persuasive and informative images converge.

    The significant interaction term indicates the difference in slope between the main effects for CHART_BEAUTY and CHART_INTENT, that is to say, that the effect of CHART_BEAUTY on CHART_TRUST is moderated such that the effect of CHART_BEAUTY is minimized when CHART_INTENT is attributed as more informative (lower values on chart_intent) than persuasive (higher values on chart_intent)

Further, model comparisons indicate that MODEL 7 (adding an interaction with MAKER_ALIGN) is a significantly better fit to the data than the MODEL 6 without the interaction term MODEL 4 without the fixed effect (\(\chi^2(1)= 10.24 , p < 0.001\)) .

Model 7 supports our claim that social attributions (in this case, both an inference about the communicative intent of the chart and inference about the data analysis skill of the maker and the extent to which the maker’s values align with the participants’) also predict beauty, and in fact can change (in the case of intent, moderate) the effect of beauty on trust.

M8 | TRUST ~ BEAUTY X INTENT + INTENT X ALIGN (REMOVE DATA)

HERE we test whether we really actually need the DATA main effect

################## FIT MODEL
f.BxIxA <-  "TRUST ~ BEAUTY X INTENT + INTENT X ALIGN + (1|PID)"
mm.BxIxA <- lmer(TRUST_z ~ BEAUTY_z * INTENT_z + INTENT_z * ALIGN_z + (1|PID), data = df)
summary(mm.BxIxA)
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: TRUST_z ~ BEAUTY_z * INTENT_z + INTENT_z * ALIGN_z + (1 | PID)
##    Data: df
## 
## REML criterion at convergence: 3412.1
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -3.8961 -0.5668 -0.0730  0.5163  4.3065 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev.
##  PID      (Intercept) 0.07926  0.2815  
##  Residual             0.43089  0.6564  
## Number of obs: 1590, groups:  PID, 318
## 
## Fixed effects:
##                     Estimate Std. Error         df t value Pr(>|t|)    
## (Intercept)        8.718e-03  2.319e-02  3.322e+02   0.376 0.707245    
## BEAUTY_z           1.355e-01  1.874e-02  1.517e+03   7.231 7.57e-13 ***
## INTENT_z          -2.762e-01  1.842e-02  1.577e+03 -15.000  < 2e-16 ***
## ALIGN_z            4.633e-01  1.975e-02  1.543e+03  23.461  < 2e-16 ***
## BEAUTY_z:INTENT_z  6.334e-02  1.753e-02  1.536e+03   3.614 0.000312 ***
## INTENT_z:ALIGN_z   5.027e-02  1.647e-02  1.560e+03   3.053 0.002306 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) BEAUTY_z INTENT_z ALIGN_ BEAUTY_:
## BEAUTY_z    -0.013                                  
## INTENT_z     0.015  0.017                           
## ALIGN_z     -0.044 -0.350    0.215                  
## BEAUTY_:INT  0.010 -0.016    0.057    0.008         
## INTENT_:ALI  0.162  0.010    0.078   -0.192 -0.386
car::Anova(mm.BxIxA, type=3) #type 3 tests for interaction model
## Analysis of Deviance Table (Type III Wald chisquare tests)
## 
## Response: TRUST_z
##                      Chisq Df Pr(>Chisq)    
## (Intercept)         0.1413  1  0.7070049    
## BEAUTY_z           52.2871  1  4.795e-13 ***
## INTENT_z          224.9862  1  < 2.2e-16 ***
## ALIGN_z           550.4328  1  < 2.2e-16 ***
## BEAUTY_z:INTENT_z  13.0587  1  0.0003019 ***
## INTENT_z:ALIGN_z    9.3192  1  0.0022677 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
################## COMPARE MODEL
compare_performance(mm.BxIxA, mm.BxIxAD, rank = TRUE)
## # Comparison of Model Performance Indices
## 
## Name      |           Model | R2 (cond.) | R2 (marg.) |   ICC |  RMSE | Sigma
## -----------------------------------------------------------------------------
## mm.BxIxAD | lmerModLmerTest |      0.585 |      0.511 | 0.153 | 0.609 | 0.641
## mm.BxIxA  | lmerModLmerTest |      0.565 |      0.486 | 0.155 | 0.623 | 0.656
## 
## Name      | AIC weights | AICc weights | BIC weights | Performance-Score
## ------------------------------------------------------------------------
## mm.BxIxAD |        1.00 |         1.00 |       1.000 |            87.50%
## mm.BxIxA  |    1.44e-17 |     1.46e-17 |    2.11e-16 |            12.50%
anova(mm.BxIxA, mm.BxIxAD)
## refitting model(s) with ML (instead of REML)
## Data: df
## Models:
## mm.BxIxA: TRUST_z ~ BEAUTY_z * INTENT_z + INTENT_z * ALIGN_z + (1 | PID)
## mm.BxIxAD: TRUST_z ~ BEAUTY_z * INTENT_z + INTENT_z * ALIGN_z + DATA_z + (1 | PID)
##           npar    AIC    BIC  logLik deviance  Chisq Df Pr(>Chisq)    
## mm.BxIxA     8 3391.0 3434.0 -1687.5   3375.0                         
## mm.BxIxAD    9 3313.4 3361.8 -1647.7   3295.4 79.558  1  < 2.2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Yes, model 7 is better is a significantly better fit that the more complex Model 8 (\(\chi^2(1)= 80 , p < 0.001\)) .

MODEL FIGURE (FIG 7) Predicting Trust

Here we produce the visualization and model parameters table reported in Figure 7.

## SET BEST MODEL
m.best <- mm.BxIxAD
f.best <- f.BxIxAD
name="BxIxAD"

## SAVE BEST MODEL
saveRDS(m.best, file = paste0("models/TRUST_bestfit_","BxIxAD",".rds"))


################## PLOT MODEL
## PLOT MODEL COEFFICIENTS
(e <- plot_model(m.best, type = "est", show.intercept = TRUE, show.p=TRUE, show.values = TRUE) + labs(title = "Model Coefficients") + theme_minimal())

## PLOT MODEL PREDICTIONS
(p <- plot_model(m.best, type = "pred", terms = c("BEAUTY_z","INTENT_z","ALIGN_z")) + theme_minimal())

(g <- (e / p) + plot_annotation(title = f.best, caption="INTENT [inform <--> persuade] \n ALIGN[does NOT share <--> DOES share my values]"))

################## PRINT MODEL TABLE
# (t <- tab_model(m.best, file = "tab.html"))
# library(webshot)
# webshot("tab.html", "figs/FIG7_Trust_Model/TRUST_model_table.png")
############
ggsave(plot= e, path="figs/FIG7_Trust_Model", filename = "TRUST_model_coefficients.png",units = c("in"), width = 8, height = 8,bg='#ffffff')
ggsave(plot = g, path="figs/FIG7_Trust_Model", filename =paste0("TRUST_model.png"), units = c("in"), width = 8, height = 10,bg='#ffffff'   )

CALCULATE PARTIAL R2

## <!-- https://chatgpt.com/c/67d6271c-15dc-800e-9e81-aa2b07a84d52 -->

## CAUTION THIS TAKES A VERY LONG TIME TO RUN 

# # install.packages("partR2")
# library(partR2)
# library(future)
# library(furrr)
# # 
# # ## setup multiple cores to 
# plan(multisession, workers = 4)
# # 
# # # Mixed model
# model <- m.best
# 
# ######## GROUP PREDICTORS
# 
# # run Partial R2
# result <- partR2(
#   model,
#   partbatch = list(
#     "BEAUTY" = "BEAUTY_z",
#     "ALIGN" = "ALIGN_z",
#     "INTENT" = "INTENT_z",
#     "DATA" = "DATA_z",
#     "BEAUTY:INTENT" = "BEAUTY_z:INTENT_z",
#     "ALIGN:INTENT" = "INTENT_z:ALIGN_z"
#   ),
#   nboot = 1000
# )

# Print
# summary(result, sort = TRUE)
# saveRDS(result, file = "models/TRUST_bestfit_mm.BxIxAD_partR2.rds")

DISPLAY PARTIAL R2

## LOAD PARTIAL R ANALYSIS 
partialR <- readRDS("models/TRUST_bestfit_mm.BxIxAD_partR2.rds") # sd questions LONG
# run the following line to see stored values for partR2
# print(partialR, sort=TRUE)

(4.3) Study 3 — Predicting Change in Social Attributions

As reported in section 4.3, here we determine which questions and which stimuli demonstrate a significant change in value from first exposure (message-obscured stimulus) to second exposure(original unobscured stimulus).

Setup Attribution Change Values

## SETUP DATA FRAME
df_change_all <- df_questions_s3 %>% 
  mutate(
    SAME = PRE==POST,
    SAME = factor(SAME, levels = c("TRUE","FALSE"))
  )

## SETUP SD ONLY ATTITUDE CHANGE DATAFRAME
df_change_sd <- df_change_all %>% 
  filter(QUESTION %in% ref_min_sd_questions) %>% 
  mutate(
    PRE = as.numeric(PRE),
    POST = as.numeric(POST),
    shift = POST-PRE
  )

(4.3) Modelling change in semantic differential questions

## SETUP DATA 
df <- df_change_sd %>% 
  filter(QUESTION %in% ref_min_sd_questions) %>% 
  mutate(
    STIMULUS = factor(STIMULUS, levels=c("B0-0","B1-2","B1-1","B1-3","B1-4")),
    QUESTION = factor(QUESTION, levels = c("DESIGN","DATA","POLITICS","TRUST","ALIGN","INTENT","BEAUTY"))
  ) %>%
  droplevels()
  


## MODEL SHIFT(RAW) by question and stimulus
  m1 <- lmer(shift ~ QUESTION + STIMULUS + (1|PID), data = df)
  summary(m1)
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: shift ~ QUESTION + STIMULUS + (1 | PID)
##    Data: df
## 
## REML criterion at convergence: 12910.9
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -3.8443 -0.3927 -0.0288  0.3549  4.5214 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev.
##  PID      (Intercept)   1.14    1.068  
##  Residual             610.12   24.701  
## Number of obs: 1400, groups:  PID, 40
## 
## Fixed effects:
##                   Estimate Std. Error        df t value Pr(>|t|)    
## (Intercept)        -0.5336     2.1960 1186.7197  -0.243  0.80807    
## QUESTIONDATA        3.9500     2.4701 1350.0000   1.599  0.11002    
## QUESTIONPOLITICS  -11.4700     2.4701 1350.0000  -4.644 3.76e-06 ***
## QUESTIONTRUST       6.9600     2.4701 1350.0000   2.818  0.00491 ** 
## QUESTIONALIGN       9.7550     2.4701 1350.0000   3.949 8.24e-05 ***
## QUESTIONINTENT     -1.3850     2.4701 1350.0000  -0.561  0.57509    
## QUESTIONBEAUTY      0.3500     2.4701 1350.0000   0.142  0.88734    
## STIMULUSB1-2       -0.3321     2.0876 1350.0000  -0.159  0.87361    
## STIMULUSB1-1        3.1536     2.0876 1350.0000   1.511  0.13112    
## STIMULUSB1-3       -4.9571     2.0876 1350.0000  -2.375  0.01771 *  
## STIMULUSB1-4       -0.4964     2.0876 1350.0000  -0.238  0.81207    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##              (Intr) QUESTIOND QUESTIONP QUESTIONT QUESTIONA QUESTIONI QUESTIONB
## QUESTIONDAT  -0.562                                                            
## QUESTIONPOL  -0.562  0.500                                                     
## QUESTIONTRU  -0.562  0.500     0.500                                           
## QUESTIONALI  -0.562  0.500     0.500     0.500                                 
## QUESTIONINT  -0.562  0.500     0.500     0.500     0.500                       
## QUESTIONBEA  -0.562  0.500     0.500     0.500     0.500     0.500             
## STIMULUSB1-2 -0.475  0.000     0.000     0.000     0.000     0.000     0.000   
## STIMULUSB1-1 -0.475  0.000     0.000     0.000     0.000     0.000     0.000   
## STIMULUSB1-3 -0.475  0.000     0.000     0.000     0.000     0.000     0.000   
## STIMULUSB1-4 -0.475  0.000     0.000     0.000     0.000     0.000     0.000   
##              STIMULUSB1-2 STIMULUSB1-1 STIMULUSB1-3
## QUESTIONDAT                                        
## QUESTIONPOL                                        
## QUESTIONTRU                                        
## QUESTIONALI                                        
## QUESTIONINT                                        
## QUESTIONBEA                                        
## STIMULUSB1-2                                       
## STIMULUSB1-1  0.500                                
## STIMULUSB1-3  0.500        0.500                   
## STIMULUSB1-4  0.500        0.500        0.500
  anova(m1)
## Type III Analysis of Variance Table with Satterthwaite's method
##          Sum Sq Mean Sq NumDF DenDF F value  Pr(>F)    
## QUESTION  56659  9443.1     6  1350 15.4774 < 2e-16 ***
## STIMULUS   9377  2344.3     4  1350  3.8423 0.00413 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
  m2 <- lmer(shift ~ QUESTION * STIMULUS + (1|PID), data = df)
  summary(m2)
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: shift ~ QUESTION * STIMULUS + (1 | PID)
##    Data: df
## 
## REML criterion at convergence: 12652.5
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -4.3351 -0.4341 -0.0204  0.3245  4.6539 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev.
##  PID      (Intercept)   2.496   1.58   
##  Residual             562.638  23.72   
## Number of obs: 1400, groups:  PID, 40
## 
## Fixed effects:
##                               Estimate Std. Error       df t value Pr(>|t|)    
## (Intercept)                     -4.625      3.759 1364.095  -1.230  0.21874    
## QUESTIONDATA                     3.225      5.304 1326.000   0.608  0.54327    
## QUESTIONPOLITICS                -3.125      5.304 1326.000  -0.589  0.55584    
## QUESTIONTRUST                   12.675      5.304 1326.000   2.390  0.01700 *  
## QUESTIONALIGN                   16.800      5.304 1326.000   3.167  0.00157 ** 
## QUESTIONINTENT                   2.875      5.304 1326.000   0.542  0.58788    
## QUESTIONBEAUTY                   4.350      5.304 1326.000   0.820  0.41228    
## STIMULUSB1-2                     1.075      5.304 1326.000   0.203  0.83942    
## STIMULUSB1-1                    14.650      5.304 1326.000   2.762  0.00582 ** 
## STIMULUSB1-3                     0.975      5.304 1326.000   0.184  0.85418    
## STIMULUSB1-4                     1.125      5.304 1326.000   0.212  0.83206    
## QUESTIONDATA:STIMULUSB1-2        2.075      7.501 1326.000   0.277  0.78211    
## QUESTIONPOLITICS:STIMULUSB1-2   -5.150      7.501 1326.000  -0.687  0.49247    
## QUESTIONTRUST:STIMULUSB1-2      -6.025      7.501 1326.000  -0.803  0.42198    
## QUESTIONALIGN:STIMULUSB1-2      -2.725      7.501 1326.000  -0.363  0.71645    
## QUESTIONINTENT:STIMULUSB1-2      6.625      7.501 1326.000   0.883  0.37727    
## QUESTIONBEAUTY:STIMULUSB1-2     -4.650      7.501 1326.000  -0.620  0.53541    
## QUESTIONDATA:STIMULUSB1-1        1.350      7.501 1326.000   0.180  0.85720    
## QUESTIONPOLITICS:STIMULUSB1-1   -9.725      7.501 1326.000  -1.297  0.19503    
## QUESTIONTRUST:STIMULUSB1-1     -12.975      7.501 1326.000  -1.730  0.08390 .  
## QUESTIONALIGN:STIMULUSB1-1     -22.575      7.501 1326.000  -3.010  0.00267 ** 
## QUESTIONINTENT:STIMULUSB1-1    -22.625      7.501 1326.000  -3.016  0.00261 ** 
## QUESTIONBEAUTY:STIMULUSB1-1    -13.925      7.501 1326.000  -1.856  0.06361 .  
## QUESTIONDATA:STIMULUSB1-3        2.200      7.501 1326.000   0.293  0.76934    
## QUESTIONPOLITICS:STIMULUSB1-3  -38.225      7.501 1326.000  -5.096 3.97e-07 ***
## QUESTIONTRUST:STIMULUSB1-3      -8.775      7.501 1326.000  -1.170  0.24227    
## QUESTIONALIGN:STIMULUSB1-3      -0.650      7.501 1326.000  -0.087  0.93096    
## QUESTIONINTENT:STIMULUSB1-3      4.125      7.501 1326.000   0.550  0.58246    
## QUESTIONBEAUTY:STIMULUSB1-3     -0.200      7.501 1326.000  -0.027  0.97873    
## QUESTIONDATA:STIMULUSB1-4       -2.000      7.501 1326.000  -0.267  0.78979    
## QUESTIONPOLITICS:STIMULUSB1-4   11.375      7.501 1326.000   1.516  0.12964    
## QUESTIONTRUST:STIMULUSB1-4      -0.800      7.501 1326.000  -0.107  0.91508    
## QUESTIONALIGN:STIMULUSB1-4      -9.275      7.501 1326.000  -1.237  0.21649    
## QUESTIONINTENT:STIMULUSB1-4     -9.425      7.501 1326.000  -1.257  0.20915    
## QUESTIONBEAUTY:STIMULUSB1-4     -1.225      7.501 1326.000  -0.163  0.87030    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation matrix not shown by default, as p = 35 > 12.
## Use print(x, correlation=TRUE)  or
##     vcov(x)        if you need it
  ##PRINT 
  print("This is the first model reported in section  4.3 ")
## [1] "This is the first model reported in section  4.3 "
  anova(m2)
## Type III Analysis of Variance Table with Satterthwaite's method
##                   Sum Sq Mean Sq NumDF DenDF F value    Pr(>F)    
## QUESTION           56659  9443.1     6  1326 16.7836 < 2.2e-16 ***
## STIMULUS            9377  2344.3     4  1326  4.1665  0.002337 ** 
## QUESTION:STIMULUS  77608  3233.7    24  1326  5.7473 < 2.2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## COMPARE PERFORMANCE
  anova(m1,m2)
## refitting model(s) with ML (instead of REML)
## Data: df
## Models:
## m1: shift ~ QUESTION + STIMULUS + (1 | PID)
## m2: shift ~ QUESTION * STIMULUS + (1 | PID)
##    npar   AIC   BIC  logLik deviance  Chisq Df Pr(>Chisq)    
## m1   13 12970 13038 -6471.8    12944                         
## m2   37 12883 13077 -6404.5    12809 134.59 24  < 2.2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
  compare_performance(m1,m2, rank = TRUE)
## # Comparison of Model Performance Indices
## 
## Name |           Model | R2 (cond.) | R2 (marg.) |   ICC |   RMSE |  Sigma
## --------------------------------------------------------------------------
## m2   | lmerModLmerTest |      0.157 |      0.154 | 0.004 | 23.377 | 23.720
## m1   | lmerModLmerTest |      0.073 |      0.072 | 0.002 | 24.582 | 24.701
## 
## Name | AIC weights | AICc weights | BIC weights | Performance-Score
## -------------------------------------------------------------------
## m2   |        1.00 |         1.00 |    2.97e-09 |            87.50%
## m1   |    1.57e-19 |     3.87e-19 |       1.000 |            12.50%
## VALUES REPORTED THESE 
## USE EMMEANS TO GET MORE INTERPRETABLE COEFFICIENTS 
library(emmeans)
## Warning: package 'emmeans' was built under R version 4.3.3
## Welcome to emmeans.
## Caution: You lose important information if you filter this package's results.
## See '? untidy'
## 
## Attaching package: 'emmeans'
## The following object is masked from 'package:GGally':
## 
##     pigs
contrast(emmeans(m2, ~ QUESTION * STIMULUS), method = "eff")
##  contrast               estimate  SE   df t.ratio p.value
##  (DESIGN B0-0) effect     -4.731 3.7 1326  -1.280  0.4576
##  (DATA B0-0) effect       -1.506 3.7 1326  -0.407  0.7978
##  (POLITICS B0-0) effect   -7.856 3.7 1326  -2.125  0.0909
##  (TRUST B0-0) effect       7.944 3.7 1326   2.149  0.0909
##  (ALIGN B0-0) effect      12.069 3.7 1326   3.265  0.0090
##  (INTENT B0-0) effect     -1.856 3.7 1326  -0.502  0.7924
##  (BEAUTY B0-0) effect     -0.381 3.7 1326  -0.103  0.9530
##  (DESIGN B1-2) effect     -3.656 3.7 1326  -0.989  0.5242
##  (DATA B1-2) effect        1.644 3.7 1326   0.445  0.7924
##  (POLITICS B1-2) effect  -11.931 3.7 1326  -3.228  0.0090
##  (TRUST B1-2) effect       2.994 3.7 1326   0.810  0.5992
##  (ALIGN B1-2) effect      10.419 3.7 1326   2.819  0.0285
##  (INTENT B1-2) effect      5.844 3.7 1326   1.581  0.2853
##  (BEAUTY B1-2) effect     -3.956 3.7 1326  -1.070  0.5242
##  (DESIGN B1-1) effect      9.919 3.7 1326   2.683  0.0308
##  (DATA B1-1) effect       14.494 3.7 1326   3.921  0.0016
##  (POLITICS B1-1) effect   -2.931 3.7 1326  -0.793  0.5992
##  (TRUST B1-1) effect       9.619 3.7 1326   2.602  0.0328
##  (ALIGN B1-1) effect       4.144 3.7 1326   1.121  0.5242
##  (INTENT B1-1) effect     -9.831 3.7 1326  -2.659  0.0308
##  (BEAUTY B1-1) effect      0.344 3.7 1326   0.093  0.9530
##  (DESIGN B1-3) effect     -3.756 3.7 1326  -1.016  0.5242
##  (DATA B1-3) effect        1.669 3.7 1326   0.452  0.7924
##  (POLITICS B1-3) effect  -45.106 3.7 1326 -12.202  <.0001
##  (TRUST B1-3) effect       0.144 3.7 1326   0.039  0.9689
##  (ALIGN B1-3) effect      12.394 3.7 1326   3.353  0.0090
##  (INTENT B1-3) effect      3.244 3.7 1326   0.878  0.5787
##  (BEAUTY B1-3) effect      0.394 3.7 1326   0.107  0.9530
##  (DESIGN B1-4) effect     -3.606 3.7 1326  -0.975  0.5242
##  (DATA B1-4) effect       -2.381 3.7 1326  -0.644  0.6995
##  (POLITICS B1-4) effect    4.644 3.7 1326   1.256  0.4576
##  (TRUST B1-4) effect       8.269 3.7 1326   2.237  0.0810
##  (ALIGN B1-4) effect       3.919 3.7 1326   1.060  0.5242
##  (INTENT B1-4) effect    -10.156 3.7 1326  -2.747  0.0304
##  (BEAUTY B1-4) effect     -0.481 3.7 1326  -0.130  0.9530
## 
## Degrees-of-freedom method: kenward-roger 
## P value adjustment: fdr method for 35 tests
# contrast(emmeans(m2, ~ QUESTION), method = "eff")
# contrast(emmeans(m2, ~ STIMULUS), method = "eff")
  
####### BEST FITTING MODEL IS IXN OF Q & STIMULUS
# plot_model(m2, show.intercept = TRUE, show.values = TRUE, show.p = TRUE)
# plot_model(m2, type = "pred", terms = c("QUESTION","STIMULUS"), show.intercept = TRUE, show.values = TRUE, show.p = TRUE, show.data=FALSE)
# plot_model(m2, type = "pred", terms = c("STIMULUS","QUESTION"), show.intercept = TRUE, show.values = TRUE, show.p = TRUE, show.data=FALSE) 

OTHER BLOCKS

Semantic Differential Questions (Other Blocks)

This plots the short-form set of semantic differential questions for each stimulus for Studies 1 & 2. Note that the blue ridge refers to Study 1, and black ridge to Study 2. (Note: these plots are written to the figs directory, not displayed inline)

#### DENSITY RIDGES#############################################################################
#### loop over questions and stimuli, vertically stack studies, color by sample

## DEFINE DF
df <- df_sd_questions_long_all%>% 
  #only block 1 for balanced data
  filter(Assigned.Block!=1) %>% 
  #drop pilot data
  filter(Study != "Study0") %>% 
  #for Study 3 ONLY, set SAMPLE = TIME (for graphing purpose)
  mutate(
    Sample = case_when(Study =="Study3" ~ TIME ,
                       .default = Sample)) %>% 
  # mutate(Sample = factor(Sample, levels = c("TUMBLR","GENERAL","POST","PRE"))) %>% 
  mutate(Study = factor(Study, levels=order_study)) %>% 
  droplevels()
  
  

## DEFINE REFS
n_q <- length(levels(df$QUESTION))
stimuli <- levels(df$STIMULUS)
questions <- ref_min_sd_questions #has qs in right order
labels <- ref_labels_min

## SET INITIAL VALUES
s <- stimuli[1]
q <- questions[1]
x = list() #list of plots

## LOOP OVER STIMULI, LOOP OVER QUESTIONS

for (s in stimuli){
  i=0
  # print(s)
  for (q in questions) {
    i = i+1
    # print(i)
    # print(q)
  
    ## FILTER Q AND CALCULATE MEDIAN
    d <- df %>% filter(STIMULUS ==s) %>% filter(QUESTION ==q) %>% 
    group_by(Study,Sample) %>% 
    mutate(m=median(value)) ## calc median for printing on graph
  
    x[[i]] <- 
      ggplot(d, aes(x = value, y = Study, fill = Sample, color = Sample )) +
      geom_density_ridges2(scale = 0.75, panel_scaling = TRUE, rel_min_height = 0.01, alpha = 0.25,
          # ## POINT JITTER GEOMETRY
          # jittered_points = TRUE, alpha = 0.7, scale = 0.9)+
           # ## RUG GEOMETRY
            jittered_points = TRUE,
            position = position_points_jitter(width = 0.5, height = 0),
            point_shape = '|', point_size = 3, point_alpha = 0.5) +
      scale_x_continuous(limits=c(0,100)) +
      scale_fill_manual(values = my_palettes(name="simple_samples", direction = "1")) +
      scale_color_manual(values = my_palettes(name="simple_samples", direction = "1")) +
      ## MEDIAN
      stat_summary(fun=median, geom="text", fontface = "bold", size= 5,
                vjust=1.5, hjust = 0.50, aes(label=round(m, digits=0)))+
      stat_summary(fun=median, geom="point", size=2) +
   
      labs (title = q, y = "", x = "") +
      guides(
        y = guide_axis_manual(labels = labels[q,"left"]),
        y.sec = guide_axis_manual(labels = labels[q,"right"]),
        # x.sec = guide_axis_manual(position = "top", title = q, breaks = NULL)
        ) +
      theme_ridges(grid = TRUE, center_axis_labels = TRUE) + easy_remove_legend() 
  
  }## END loop over questions

  ## JOIN QUESTION LEVEL PLOTS FOR THIS STIMULUS
  title <- ref_stimuli %>% filter(ID == s) %>% select(NAME)  ##TODO IF NOT WORK ref_stim_id
  title <- paste(s,"|",title)
  p <- x[[1]] / x[[2]] /x[[3]] / x[[4]] /x[[5]] / x[[6]] /x[[7]] 
  p <- p + plot_annotation(
     title = title,
     subtitle ="", caption = "(point is median)")
  
  ## SAVE GRAPH FOR THIS STIMULIS 
  if(GRAPH_SAVE == TRUE) {
     ggsave(plot = p, path="figs/OTHER_Blocks", filename =paste0("SD_ridges_",s,".png"), units = c("in"), width = 8, height = 24,  bg='#ffffff'  )}

1}## END LOOP OVER STIMULI

Categorical Questions (Other Blocks)

## SETUP DATA 
 df <- df_graphs %>% 
  select(PID, Assigned.Block, Study, STIMULUS, ENCOUNTER, MAKER_ID, MAKER_AGE,MAKER_GENDER) %>% 
  filter(Study %in% c("Study1", "Study2")) %>%
  filter(Assigned.Block !=1) %>% 
  mutate(Study = factor(Study, levels=order_study)) 
  


######## FACETED BARPLOT MAKER
(ID <-  df %>% 
  ggplot(aes(x=Study, fill=MAKER_ID)) + 
    geom_bar(position="fill") + 
    scale_fill_manual(values = my_palettes(name="reds", direction = "1"))+
   facet_wrap( .~ STIMULUS) + 
   coord_flip() +
   labs(title="MAKER_BY_STIMULUS")

)

######## FACETED BARPLOT AGE
(AGE <- df %>% 
  ggplot(aes(x=Study, fill=MAKER_AGE)) + 
    geom_bar(position="fill") + 
    scale_fill_manual(values = my_palettes(name="lightblues", direction = "1"))+
   facet_wrap( .~ STIMULUS) + 
   coord_flip() + 
    labs(title="AGE_BY_STIMULUS")
) 

######## FACETED BARPLOT GENDER
(GENDER <-  df %>% 
  ggplot(aes(x=Study, fill=MAKER_GENDER)) + 
    geom_bar(position="fill") + 
    scale_fill_manual(values = my_palettes(name="smallgreens", direction = "1"))+
   facet_wrap( .~ STIMULUS) + 
   coord_flip()+
   labs(title="GENDER_BY_STIMULUS")
)   

######## FACETED BARPLOT ENCOUNTER
(ENCOUNTER <-  df %>% 
  ggplot(aes(x=Study, fill=ENCOUNTER)) + 
    geom_bar(position="fill") + 
    scale_fill_manual(values = my_palettes(name="encounter", direction = "1"))+
   facet_wrap( .~ STIMULUS) + 
   coord_flip() + 
   labs(title="ENCOUNTER_ID_BY_STIMULUS")
)

if(GRAPH_SAVE){
  
ggsave(plot = ID, path="figs/OTHER_Blocks", filename =paste0("MAKER_by_stimulus.png"), units = c("in"), width = 12, height = 12 ,  bg='#ffffff'  )
  
ggsave(plot = AGE, path="figs/OTHER_Blocks", filename =paste0("AGE_by_stimulus.png"), units = c("in"), width = 12, height = 12 ,  bg='#ffffff'  )
  
ggsave(plot = GENDER, path="figs/OTHER_Blocks", filename =paste0("GENDER_by_stimulus.png"), units = c("in"), width = 12, height = 12 ,  bg='#ffffff'  )
  
ggsave(plot = ENCOUNTER, path="figs/OTHER_Blocks", filename =paste0("ENCOUNTER_by_stimulus.png"), units = c("in"), width = 12, height = 12 ,  bg='#ffffff'  )
}

SESSION

sessionInfo()
## R version 4.3.2 (2023-10-31)
## Platform: x86_64-apple-darwin20 (64-bit)
## Running under: macOS Sonoma 14.7.2
## 
## Matrix products: default
## BLAS:   /Library/Frameworks/R.framework/Versions/4.3-x86_64/Resources/lib/libRblas.0.dylib 
## LAPACK: /Library/Frameworks/R.framework/Versions/4.3-x86_64/Resources/lib/libRlapack.dylib;  LAPACK version 3.11.0
## 
## locale:
## [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
## 
## time zone: America/New_York
## tzcode source: internal
## 
## attached base packages:
## [1] stats     graphics  grDevices utils     datasets  methods   base     
## 
## other attached packages:
##  [1] emmeans_1.10.7     rstatix_0.7.2      kSamples_1.2-10    SuppDists_1.1-9.8 
##  [5] jmv_2.5.6          lmerTest_3.1-3     lme4_1.1-36        Matrix_1.6-5      
##  [9] sjPlot_2.8.17      see_0.11.0         report_0.6.1       parameters_0.24.2 
## [13] performance_0.13.0 modelbased_0.10.0  insight_1.1.0      effectsize_1.0.0  
## [17] datawizard_1.0.1   correlation_0.8.7  bayestestR_0.15.2  easystats_0.7.4   
## [21] jtools_2.3.0       ggsankey_0.0.99999 tidygraph_1.3.1    interactions_1.2.0
## [25] paletteer_1.6.0    plotly_4.10.4      RColorBrewer_1.1-3 viridis_0.6.5     
## [29] viridisLite_0.4.2  ggdist_3.3.2       patchwork_1.3.0    ggh4x_0.3.0       
## [33] ggeasy_0.1.5       corrplot_0.95      GGally_2.2.1       gghalves_0.1.4    
## [37] ggstatsplot_0.13.0 ggformula_0.12.0   ggridges_0.5.6     scales_1.3.0      
## [41] qacBase_1.0.3      webshot2_0.1.1     tinytable_0.6.1    summarytools_1.1.1
## [45] magrittr_2.0.3     lubridate_1.9.4    forcats_1.0.0      stringr_1.5.1     
## [49] dplyr_1.1.4        purrr_1.0.4        readr_2.1.5        tidyr_1.3.1       
## [53] tibble_3.2.1       ggplot2_3.5.1      tidyverse_2.0.0    psych_2.4.12      
## [57] Hmisc_5.2-2       
## 
## loaded via a namespace (and not attached):
##   [1] splines_4.3.2          later_1.4.1            jmvcore_2.6.3         
##   [4] rpart_4.1.24           ggExtra_0.10.1         lifecycle_1.0.4       
##   [7] Rdpack_2.6.2           tcltk_4.3.2            globals_0.16.3        
##  [10] processx_3.8.6         lattice_0.22-6         MASS_7.3-60.0.1       
##  [13] backports_1.5.0        sass_0.4.9             rmarkdown_2.29        
##  [16] jquerylib_0.1.4        yaml_2.3.10            httpuv_1.6.15         
##  [19] minqa_1.2.8            chromote_0.4.0         abind_1.4-8           
##  [22] multcomp_1.4-28        nnet_7.3-20            TH.data_1.1-3         
##  [25] sandwich_3.1-1         labelled_2.14.0        pbkrtest_0.5.3        
##  [28] listenv_0.9.1          parallelly_1.42.0      codetools_0.2-20      
##  [31] tidyselect_1.2.1       ggeffects_2.2.1        farver_2.1.2          
##  [34] gmp_0.7-5              broom.mixed_0.2.9.6    matrixStats_1.5.0     
##  [37] base64enc_0.1-3        jsonlite_1.9.1         Formula_1.2-5         
##  [40] survival_3.8-3         systemfonts_1.1.0      BWStest_0.2.3         
##  [43] tools_4.3.2            ragg_1.3.3             pryr_0.1.6            
##  [46] PMCMRplus_1.9.12       Rcpp_1.0.14            glue_1.8.0            
##  [49] mnormt_2.1.1           gridExtra_2.3          xfun_0.51             
##  [52] distributional_0.5.0   websocket_1.4.2        numDeriv_2016.8-1.1   
##  [55] withr_3.0.2            fastmap_1.2.0          fansi_1.0.6           
##  [58] boot_1.3-31            digest_0.6.37          timechange_0.3.0      
##  [61] R6_2.6.1               mime_0.12              estimability_1.5.1    
##  [64] textshaping_1.0.0      colorspace_2.1-1       generics_0.1.3        
##  [67] data.table_1.17.0      httr_1.4.7             htmlwidgets_1.6.4     
##  [70] ggstats_0.9.0          pkgconfig_2.0.3        gtable_0.3.6          
##  [73] Rmpfr_1.0-0            statsExpressions_1.6.2 furrr_0.3.1           
##  [76] htmltools_0.5.8.1      carData_3.0-5          multcompView_0.1-10   
##  [79] snakecase_0.11.1       reformulas_0.4.0       knitr_1.49            
##  [82] rstudioapi_0.17.1      tzdb_0.4.0             reshape2_1.4.4        
##  [85] nloptr_2.2.0           coda_0.19-4.1          checkmate_2.3.2       
##  [88] nlme_3.1-167           ggcorrplot_0.1.4.1     cachem_1.1.0          
##  [91] zoo_1.8-13             sjlabelled_1.2.0       parallel_4.3.2        
##  [94] miniUI_0.1.1.1         foreign_0.8-88         pillar_1.10.1         
##  [97] grid_4.3.2             vctrs_0.6.5            promises_1.3.2        
## [100] car_3.1-3              xtable_1.8-4           cluster_2.1.8.1       
## [103] GPArotation_2024.3-1   htmlTable_2.4.3        evaluate_1.0.3        
## [106] zeallot_0.1.0          magick_2.8.5           mvtnorm_1.3-3         
## [109] cli_3.6.4              compiler_4.3.2         rlang_1.1.5           
## [112] crayon_1.5.3           rstantools_2.4.0       labeling_0.4.3        
## [115] rematch2_2.1.2         ps_1.9.0               sjmisc_2.8.10         
## [118] plyr_1.8.9             stringi_1.8.4          pander_0.6.6          
## [121] munsell_0.5.1          lazyeval_0.2.2         mosaicCore_0.9.4.0    
## [124] sjstats_0.19.0         rapportools_1.2        hms_1.1.3             
## [127] future_1.34.0          shiny_1.10.0           haven_2.5.4           
## [130] rbibutils_2.3          igraph_2.1.4           broom_1.0.7           
## [133] memoise_2.0.1          RcppParallel_5.1.10    bslib_0.9.0